pkg/oasim/oasim_clrtrans.F

87dd4f7d5f Oliv*0001 #include "OASIM_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: OASIM_CLRTRANS
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE OASIM_CLRTRANS(
                0009      I        cosunz,rm,rmp,ta,wa,asym,
                0010      O        Td,Ts,
                0011      I        myThid)
                0012
                0013 C     !DESCRIPTION:
                0014 C     Model for atmospheric transmittance of solar irradiance through
                0015 C     a cloudless maritime atmosphere.  Computes direct and diffuse
                0016 C     separately.  From Gregg and Carder (1990) Limnology and
                0017 C     Oceanography 35(8): 1657-1675.
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "OASIM_SIZE.h"
                0024 #include "OASIM_INTERNAL.h"
                0025
                0026 C     !INPUT PARAMETERS:
                0027       _RL cosunz,rm,rmp
                0028       _RL ta(nlt),asym(nlt),wa(nlt)
                0029       INTEGER myThid
                0030
                0031 C     !OUTPUT PARAMETERS:
                0032 c     Td :: spectral clear sky direct transmittance
                0033 c     Ts :: spectral clear sky diffuse transmittance
                0034       _RL Td(nlt),Ts(nlt)
                0035 CEOP
                0036
                0037 #ifdef ALLOW_OASIM
                0038
                0039 C     !LOCAL VARIABLES:
                0040       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0041       INTEGER l
                0042       _RL afs,bfs
                0043       _RL rtra,alg,Fa,tarm,atra,taa,tas,dray,daer
                0044
                0045 c  Compute spectral transmittance
                0046       DO l = 1,nlt
                0047 c    Rayleigh
                0048        rtra = EXP(-thray(l)*rmp)       !transmittance
                0049 c   Aerosols
                0050        alg = log(1.0 _d 0-asym(l))
                0051        afs = alg*(1.459 _d 0+alg*(.1595 _d 0+alg*.4129 _d 0))
                0052        bfs = alg*(.0783 _d 0+alg*(-.3824 _d 0-alg*.5874 _d 0))
                0053        IF (ta(l) .LT. 0.0 _d 0 .OR. wa(l) .LT. 0.0 _d 0)THEN
                0054         WRITE(msgBuf,'(A)') 'OASIM_CLRTRANS: error in ta or omega'
                0055         CALL PRINT_ERROR( msgBuf , myThid)
                0056         WRITE(msgBuf,'(2A,I3,1P3E15.6)') 'OASIM_CLRTRANS: ',
                0057      &       'l,ta,wa,asym = ',l,ta(l),wa(l),asym(l)
                0058         CALL PRINT_ERROR( msgBuf , myThid)
                0059        ENDIF
                0060        Fa = 1.0 _d 0 - 0.5 _d 0*EXP((afs+bfs*cosunz)*cosunz)
                0061        IF (Fa .LT. 0.0 _d 0)THEN
                0062         WRITE(msgBuf,'(A)') 'OASIM_CLRTRANS: error in Fa'
                0063         CALL PRINT_ERROR( msgBuf , myThid)
                0064         WRITE(msgBuf,'(2A,I3,1P3E15.6)') 'OASIM_CLRTRANS: ',
                0065      &       'l,ta,wa,asym = ',l,ta(l),wa(l),asym(l)
                0066         CALL PRINT_ERROR( msgBuf , myThid)
                0067        ENDIF
                0068        tarm = ta(l)*rm
                0069        atra = EXP(-tarm)
                0070        taa = EXP(-(1.0 _d 0-wa(l))*tarm)
                0071        tas = EXP(-wa(l)*tarm)
                0072 c  Direct transmittance
                0073        Td(l) = rtra*atra
                0074 c
                0075 c   Diffuse transmittance
                0076        dray = taa*0.5 _d 0*(1.0 _d 0-rtra**.95 _d 0)
                0077        daer = rtra**1.5 _d 0*taa*Fa*(1.0 _d 0-tas)
                0078 c
                0079 c  Total diffuse
                0080        Ts(l) = dray + daer
                0081 c
                0082       ENDDO
                0083
                0084 #endif /* ALLOW_OASIM */
                0085
                0086       RETURN
                0087       END