pkg/oasim/oasim_calc_above.F

87dd4f7d5f Oliv*0001 #include "OASIM_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: OASIM_CALC_ABOVE
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE OASIM_CALC_ABOVE( daycor, dodiags, myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     compute above-water irradiances
                0012
                0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "OASIM_SIZE.h"
                0019 #include "OASIM_PARAMS.h"
                0020 #include "OASIM_INTERNAL.h"
                0021 #include "OASIM_FIELDS.h"
                0022
                0023 C     !INPUT PARAMETERS:
                0024 C     daycor   :: correction to earth-sun distance for current day
                0025 C     myThid   :: my Thread Id number
                0026       _RL     daycor
                0027       LOGICAL dodiags
                0028       INTEGER myThid
                0029 CEOP
                0030
                0031 #ifdef ALLOW_OASIM
                0032
                0033 C     !LOCAL VARIABLES:
                0034       CHARACTER*8 diagName
                0035       INTEGER i,j,bi,bj,l
                0036       _RL cov, clwp, cosunz, wvapor
                0037       _RL re, ozone, pres, relhum, sunz, ws
                0038       _RL betaaer, etaaer, wa1, asym1
                0039       _RL ta(nlt),wa(nlt),asym(nlt)
                0040       _RL Edl(nlt),Esl(nlt)
                0041       _RL Edclrl(nlt),Esclrl(nlt)
                0042       _RL Edcldl(nlt),Escldl(nlt)
                0043       _RL Edclr(sNx,sNy,nlt),Esclr(sNx,sNy,nlt)
                0044       _RL Edcld(sNx,sNy,nlt),Escld(sNx,sNy,nlt)
                0045       _RL tauao(sNx,sNy,nlt)
                0046       _RL asympo(sNx,sNy,nlt)
                0047       _RL ssalbo(sNx,sNy,nlt)
                0048 c
                0049 c  Initialize arrays everytime
                0050       oasim_Edabove = 0.0 _d 0
                0051       oasim_Esabove = 0.0 _d 0
                0052 c
                0053 c could be taken from sunmod!(?)
                0054 c  Obtain Earth-Sun distance only for the middle of the hour
                0055 c      hr = float(ihr)
                0056 c      rday = float(iday) + hr*o24
                0057 c      daycor = (1.0 _d 0+1.67 _d -2*cos(pi2*(rday-3.0 _d 0)/365.0 _d 0))**2
                0058 c
                0059 c  Compute Ed, Es just above surface
                0060       DO bj=myByLo(myThid),myByHi(myThid)
                0061       DO bi=myBxLo(myThid),myBxHi(myThid)
                0062
                0063       DO j=1,sNy
                0064       DO i=1,sNx
                0065 c   atmospheric gases
                0066         pres = slp(i,j,bi,bj)
                0067         ws = wsm(i,j,bi,bj)
                0068         ozone = oz(i,j,bi,bj)
                0069         wvapor = wv(i,j,bi,bj)
                0070         relhum = rh(i,j,bi,bj)
                0071
                0072 c   aerosols
                0073 C       Obtain aerosol parameters; simplified Navy aerosol model
                0074         CALL OASIM_NAVAER(relhum,oasim_am,oasim_Vi,ws,
                0075      O                    betaaer,etaaer,wa1,asym1,
                0076      I                    myThid)
                0077         DO l = 1,nlt
                0078          ta(l) = taua(i,j,bi,bj,l)
                0079          asym(l) = asymp(i,j,bi,bj,l)
                0080          wa(l) = ssalb(i,j,bi,bj,l)
                0081          IF (ta(l) .LT. 0.0 _d 0)THEN
                0082           ta(l) = betaaer*rlamu(l)**etaaer
                0083          ENDIF
                0084          IF (wa(l) .LT. 0.0 _d 0)THEN
                0085           wa(l) = wa1
                0086          ENDIF
                0087          IF (asym(l) .LT. 0.0 _d 0 .OR. asym(l) .GE. 1.0 _d 0) THEN
                0088           asym(l) = asym1
                0089          ENDIF
                0090          tauao(i,j,l) = ta(l)
                0091          asympo(i,j,l) = asym(l)
                0092          ssalbo(i,j,l) = wa(l)
                0093         ENDDO
                0094
                0095 c   clouds
                0096         cov = ccov(i,j,bi,bj)
                0097         clwp = rlwp(i,j,bi,bj)
                0098         re = cdre(i,j,bi,bj)
                0099
                0100         cosunz = COS(oasim_solz(i,j,bi,bj)/rad)
                0101         sunz = oasim_solz(i,j,bi,bj)
                0102         IF (sunz .LT. 90.0 _d 0)THEN
                0103 c   Ed, Es
                0104          CALL OASIM_LIGHT(sunz,cosunz,daycor,
                0105      I    pres,ws,ozone,wvapor,relhum,
                0106      I    ta,wa,asym,cov,clwp,re,
                0107      O    Edl,Esl,Edclrl,Esclrl,Edcldl,Escldl,
                0108      I    myThid)
                0109         ELSE
                0110          DO l = 1,nlt
                0111           Edl(l) = 0.0 _d 0
                0112           Esl(l) = 0.0 _d 0
                0113           Edclrl(l) = 0.0 _d 0
                0114           Esclrl(l) = 0.0 _d 0
                0115           Edcldl(l) = 0.0 _d 0
                0116           Escldl(l) = 0.0 _d 0
                0117          ENDDO
                0118         ENDIF
                0119         DO l = 1,nlt
                0120          OASIM_Edabove(i,j,bi,bj,l) = Edl(l)
                0121          OASIM_Esabove(i,j,bi,bj,l) = Esl(l)
                0122          Edclr(i,j,l) = Edclrl(l)
                0123          Esclr(i,j,l) = Esclrl(l)
                0124          Edcld(i,j,l) = Edcldl(l)
                0125          Escld(i,j,l) = Escldl(l)
                0126         ENDDO
                0127       ENDDO
                0128       ENDDO
                0129
                0130 #ifdef ALLOW_DIAGNOSTICS
                0131       IF (useDiagnostics .AND. dodiags) THEN
                0132        DO l = 1,nlt
                0133         WRITE(diagName,'(A5,I3.3)')'Edclr',l
                0134         CALL DIAGNOSTICS_FILL(Edclr(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0135         WRITE(diagName,'(A5,I3.3)')'Esclr',l
                0136         CALL DIAGNOSTICS_FILL(Esclr(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0137         WRITE(diagName,'(A5,I3.3)')'Edcld',l
                0138         CALL DIAGNOSTICS_FILL(Edcld(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0139         WRITE(diagName,'(A5,I3.3)')'Escld',l
                0140         CALL DIAGNOSTICS_FILL(Escld(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0141         WRITE(diagName,'(A4,I3.3)')'taua',l
                0142         CALL DIAGNOSTICS_FILL(tauao(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0143         WRITE(diagName,'(A5,I3.3)')'asymp',l
                0144         CALL DIAGNOSTICS_FILL(asympo(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0145         WRITE(diagName,'(A5,I3.3)')'ssalb',l
                0146         CALL DIAGNOSTICS_FILL(ssalbo(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0147        ENDDO
                0148       ENDIF
                0149 #endif
                0150
                0151       ENDDO ! bi
                0152       ENDDO ! bj
                0153
                0154 #endif /* ALLOW_OASIM */
                0155
                0156       RETURN
                0157       END