pkg/oasim/oasim_forcing.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_FORCING
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE OASIM_FORCING( dodiags, myTime, myIter, myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     Main driver for OASIM state package.
                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 #ifdef ALLOW_EXF
                0023 #include "OASIM_EXF_PARAMS.h"
                0024 #endif
                0025
                0026 C     !INPUT PARAMETERS:
                0027 C     myTime   :: Current time of simulation ( s )
                0028 C     myIter   :: Current iteration number in simulation
                0029 C     myThid   :: my Thread Id number
                0030       LOGICAL dodiags
                0031       _RL     myTime
                0032       INTEGER myIter, myThid
                0033 CEOP
                0034
                0035 #ifdef ALLOW_OASIM
                0036
                0037 C     !FUNCTIONS:
                0038       LOGICAL DIAGNOSTICS_IS_ON
                0039       EXTERNAL DIAGNOSTICS_IS_ON
                0040
                0041 C     !LOCAL VARIABLES:
                0042       CHARACTER*8 diagName
                0043       _RL daycor, rday, secs, ylen
                0044       INTEGER year, imon, iday, ss, lp, wd, currentdate(4)
                0045       INTEGER yday, yymmdd, difftime(4), yearstart(4)
                0046       INTEGER i, j, l, bi, bj
                0047       _RL sPARF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0048
                0049 C compute solar zenith angles
                0050       CALL OASIM_CALC_SOLZ( myTime, myIter, myThid )
                0051
                0052 c compute approximate correction to earth-sun distance
                0053 #ifdef ALLOW_CAL
                0054       CALL cal_GetDate( myiter, mytime, currentdate, mythid )
                0055       CALL cal_convDate( currentdate,year,imon,iday,ss,lp,wd,mythid )
                0056 C     compute yearday
                0057       yymmdd = year*10000 + 101
                0058       CALL cal_fullDate( yymmdd, 0, yearstart, mythid )
                0059       CALL cal_timePassed( yearstart, currentdate, difftime, mythid )
                0060       CALL cal_ToSeconds (difftime,secs,myThid)
                0061       rday = (secs+0.5 _d 0*deltaT)/86400.0 _d 0 + 1.0 _d 0
                0062       ylen = 365.0 _d 0
                0063 c      print*,'iter',myIter,'rday',rday
                0064 #else
                0065 c     make up a yearday
                0066       year = FLOOR(myTime/31104000. _d 0)
                0067       secs = (myTime - 31104000. _d 0*year)
                0068       rday = secs/86400. _d 0 + 1.0 _d 0
                0069       ylen = 360.0 _d 0
                0070 #endif
                0071       daycor = (1.0 _d 0 + 1.67 _d -2*cos(pi2*(rday-3.0 _d 0)/ylen))**2
                0072
                0073 C compute irradiances above sea surface
                0074       CALL OASIM_CALC_ABOVE( daycor, dodiags, myThid )
                0075
                0076 C compute sea-surface reflectance and irradiances below surface
                0077       CALL OASIM_CALC_BELOW( dodiags, myThid )
                0078
                0079 #ifdef ALLOW_DIAGNOSTICS
                0080       IF (useDiagnostics .AND. dodiags) THEN
                0081        DO l=1,nlt
                0082         WRITE(diagName,'(A5,I3.3)')'Edabv',l
                0083         CALL DIAGNOSTICS_FILL(OASIM_Edabove(1-OLx,1-OLy,1,1,l),
                0084      &                                       diagName,0,1,0,1,1,myThid)
                0085         WRITE(diagName,'(A5,I3.3)')'Esabv',l
                0086         CALL DIAGNOSTICS_FILL(OASIM_Esabove(1-OLx,1-OLy,1,1,l),
                0087      &                                       diagName,0,1,0,1,1,myThid)
                0088         WRITE(diagName,'(A5,I3.3)')'Edblw',l
                0089         CALL DIAGNOSTICS_FILL(OASIM_Edbelow(1-OLx,1-OLy,1,1,l),
                0090      &                                       diagName,0,1,0,1,1,myThid)
                0091         WRITE(diagName,'(A5,I3.3)')'Esblw',l
                0092         CALL DIAGNOSTICS_FILL(OASIM_Esbelow(1-OLx,1-OLy,1,1,l),
                0093      &                                       diagName,0,1,0,1,1,myThid)
                0094        ENDDO
                0095        CALL DIAGNOSTICS_FILL(OASIM_solz,'OASIMsol',0,1,0,1,1,myThid)
                0096        CALL DIAGNOSTICS_FILL(OASIM_rmud,'OASIMrmd',0,1,0,1,1,myThid)
                0097        IF (DIAGNOSTICS_IS_ON('sPARblw ', myThid)) THEN
                0098         DO bj=myByLo(myThid),myByHi(myThid)
                0099          DO bi=myBxLo(myThid),myBxHi(myThid)
                0100           DO j=1,sNy
                0101            DO i=1,sNx
                0102             sPARF(i,j) = 0 _d 0
                0103            ENDDO
                0104           ENDDO
                0105           DO l=1,nlt
                0106            DO j=1,sNy
                0107             DO i=1,sNx
                0108              sPARF(i,j) = sPARF(i,j) + (
                0109      &                oasim_rmud(i,j,bi,bj)*OASIM_Edbelow(i,j,bi,bj,l)
                0110      &              + oasim_rmus*OASIM_Esbelow(i,j,bi,bj,l)
                0111      &              )*WtouEins(l)*oasim_PARwgt(l)
                0112             ENDDO
                0113            ENDDO
                0114           ENDDO
                0115           CALL DIAGNOSTICS_FILL(sPARF,'sPARblw ',0,1,2,bi,bj,myThid)
                0116          ENDDO
                0117         ENDDO
                0118        ENDIF
                0119       ENDIF
                0120 #endif
                0121
                0122 #endif /* ALLOW_OASIM */
                0123
                0124       RETURN
                0125       END