pkg/oasim/oasim_calc_below.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_BELOW
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE OASIM_CALC_BELOW( dodiags, myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     compute below-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     myThid   :: my Thread Id number
                0025       LOGICAL dodiags
                0026       INTEGER myThid
                0027 CEOP
                0028
                0029 #ifdef ALLOW_OASIM
                0030
                0031 C     !LOCAL VARIABLES:
                0032       CHARACTER*8 diagName
                0033       INTEGER i,j,bi,bj,l
                0034       _RL rsolzw
                0035       _RL rod(sNx,sNy,nlt), ros(sNx,sNy,nlt)
                0036       _RL rodl(nlt), rosl(nlt)
                0037       _RL E0(sNx,sNy)
                0038 c
                0039       DO bj=myByLo(myThid),myByHi(myThid)
                0040       DO bi=myBxLo(myThid),myBxHi(myThid)
                0041
                0042        DO j=1,sNy
                0043        DO i=1,sNx
                0044         rsolzw = ASIN(SIN(oasim_solz(i,j,bi,bj)/rad)/rn)
                0045         oasim_rmud(i,j,bi,bj) = MAX(0.0, MIN(1.5 _d 0, 1/COS(rsolzw)))
                0046        ENDDO
                0047        ENDDO
                0048
                0049        DO j=1,sNy
                0050        DO i=1,sNx
                0051         CALL OASIM_SFCRFL(oasim_solz(i,j,bi,bj), wsm(i,j,bi,bj),
                0052      O              rodl, rosl,
                0053      I              myThid)
                0054         DO l=1,nlt
                0055          rod(i,j,l) = rodl(l)
                0056          ros(i,j,l) = rosl(l)
                0057         ENDDO
                0058        ENDDO
                0059        ENDDO
                0060
                0061        DO l=1,nlt
                0062
                0063         DO j=1,sNy
                0064         DO i=1,sNx
                0065          oasim_edbelow(i,j,bi,bj,l) = oasim_edabove(i,j,bi,bj,l)
                0066      &                                *(1-rod(i,j,l))
                0067          oasim_esbelow(i,j,bi,bj,l) = oasim_esabove(i,j,bi,bj,l)
                0068      &                                *(1-ros(i,j,l))
                0069          E0(i,j) = oasim_rmud(i,j,bi,bj)*oasim_edbelow(i,j,bi,bj,l)
                0070      &                      + oasim_rmus*oasim_esbelow(i,j,bi,bj,l)
                0071         ENDDO
                0072         ENDDO
                0073
                0074 #ifdef ALLOW_DIAGNOSTICS
                0075         IF (useDiagnostics .AND. dodiags) THEN
                0076          WRITE(diagName,'(A5,I3.3)')'OArod',l
                0077          CALL DIAGNOSTICS_FILL(rod(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0078          WRITE(diagName,'(A5,I3.3)')'OAros',l
                0079          CALL DIAGNOSTICS_FILL(ros(1,1,l),diagName,0,1,3,bi,bj,myThid)
                0080          WRITE(diagName,'(A5,I3.3)')'E0blw',l
                0081          CALL DIAGNOSTICS_FILL(E0,diagName,0,1,3,bi,bj,myThid)
                0082         ENDIF
                0083 #endif
                0084
                0085 C      l
                0086        ENDDO
                0087
                0088       ENDDO  ! bi
                0089       ENDDO  ! bj
                0090
                0091 #endif /* ALLOW_OASIM */
                0092
                0093       RETURN
                0094       END
                0095
                0096
                0097 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0098 CBOP
                0099 C     !ROUTINE: OASIM_SFCRFL
                0100
                0101 C     !INTERFACE:
                0102       SUBROUTINE OASIM_SFCRFL(
                0103      I                        theta,ws,
                0104      O                        rod,ros,
                0105      I                        myThid)
                0106
                0107 C     !DESCRIPTION:
                0108 C     Computes surface reflectance for direct (rod) and diffuse (ros)
                0109 C     components separately, as a function of theta, wind speed or stress.
                0110 C     Includes spectral dependence of foam reflectance derived from Frouin
                0111 C     et al., 1996 (JGR)
                0112
                0113 C     !USES:
                0114       IMPLICIT NONE
                0115 #include "SIZE.h"
                0116 #include "OASIM_SIZE.h"
                0117 #include "OASIM_INTERNAL.h"
                0118
                0119 C     !INPUT PARAMETERS:
                0120       _RL theta, ws
                0121       INTEGER myThid
                0122
                0123 C     !OUTPUT PARAMETERS:
                0124       _RL rod(nlt),ros(nlt)
                0125
                0126 #ifdef ALLOW_OASIM
                0127
                0128 C     !LOCAL VARIABLES:
                0129       INTEGER l
                0130       _RL a, b, cn, rpls, rmin, rospd, rof, rosps, sintr, rtheta
                0131       _RL rthetar, sinrmin, sinp, sinrpls, tanrmin, tanp, tanrpls
                0132 c
                0133 c  Foam and diffuse reflectance
                0134       IF (ws .GT. 4.0 _d 0)THEN
                0135        IF (ws .LE. 7.0 _d 0)THEN
                0136         cn = 6.2 _d -4 + 1.56 _d -3/ws
                0137         rof = roair*cn*2.2 _d -5*ws*ws - 4.0 _d -4
                0138        ELSE
                0139         cn = 0.49 _d -3 + 0.065 _d -3*ws
                0140         rof = (roair*cn*4.5 _d -5 - 4.0 _d -5)*ws*ws
                0141        ENDIF
                0142        rosps = 0.057 _d 0
                0143       ELSE
                0144        rof = 0.0 _d 0
                0145        rosps = 0.066 _d 0
                0146       ENDIF
                0147 c
                0148 c  Direct
                0149 c   Fresnel reflectance for theta < 40, ws < 2 m/s
                0150       IF (theta .LT. 40.0 _d 0 .OR. ws .LT. 2.0 _d 0)THEN
                0151        IF (theta .EQ. 0.0 _d 0)THEN
                0152         rospd = 0.0211 _d 0
                0153        ELSE
                0154         rtheta = theta/rad
                0155         sintr = SIN(rtheta)/rn
                0156         rthetar = ASIN(sintr)
                0157         rmin = rtheta - rthetar
                0158         rpls = rtheta + rthetar
                0159         sinrmin = SIN(rmin)
                0160         sinrpls = SIN(rpls)
                0161         tanrmin = TAN(rmin)
                0162         tanrpls = TAN(rpls)
                0163         sinp = (sinrmin*sinrmin)/(sinrpls*sinrpls)
                0164         tanp = (tanrmin*tanrmin)/(tanrpls*tanrpls)
                0165         rospd = 0.5 _d 0*(sinp + tanp)
                0166        ENDIF
                0167       ELSE
                0168 c   Empirical fit otherwise
                0169        a = 0.0253 _d 0
                0170        b = -7.14 _d -4*ws + 0.0618 _d 0
                0171        rospd = a*EXP(b*(theta-40.0 _d 0))
                0172       ENDIF
                0173 c
                0174 c  Reflectance totals
                0175       DO l = 1,nlt
                0176        rod(l) = rospd + rof*wfac(l)
                0177        ros(l) = rosps + rof*wfac(l)
                0178       ENDDO
                0179 c
                0180 #endif /* ALLOW_OASIM */
                0181
                0182       RETURN
                0183       END