pkg/atm2d/fixed_flux_add.F

09a6f3668a Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003
                0004 C     !INTERFACE:
7ad882c4ff Jeff*0005       SUBROUTINE FIXED_FLUX_ADD( inMonth, wght0, wght1,
09a6f3668a Jeff*0006      &                   intime0, intime1, iftime, myIter, myThid)
                0007 C     *==========================================================*
                0008 C     | Add fixed flux files to the surface forcing fields. These|
                0009 c     | can be OBS fields or derived fields for anomaly coupling.|
                0010 C     *==========================================================*
                0011         IMPLICIT NONE
                0012
                0013 C     === Global Atmos/Ocean/Seaice Interface Variables ===
                0014 #include "ATMSIZE.h"
                0015 #include "SIZE.h"
709ddc5d16 Jeff*0016 #include "GRID.h"
09a6f3668a Jeff*0017 #include "EEPARAMS.h"
                0018 #include "THSICE_VARS.h"
                0019 #include "ATM2D_VARS.h"
                0020
                0021 C     !INPUT/OUTPUT PARAMETERS:
                0022 C     === Routine arguments ===
7ad882c4ff Jeff*0023 C     inMonth - current month
09a6f3668a Jeff*0024 C     wght0, wght1   - weight of first and second month, respectively
                0025 C     intime0,intime1- month id # for first and second months
                0026 C     iftime - true -> prompts a reloading of data from disk
                0027 C     myIter - Ocean iteration number
                0028 C     myThid - Thread no. that called this routine.
7ad882c4ff Jeff*0029       INTEGER inMonth
09a6f3668a Jeff*0030       _RL  wght0
                0031       _RL  wght1
                0032       INTEGER intime0
                0033       INTEGER intime1
                0034       LOGICAL iftime
                0035       INTEGER myIter
                0036       INTEGER myThid
                0037
                0038 C     LOCAL VARIABLES:
709ddc5d16 Jeff*0039       _RL qfadj     ! temp variable for qflux adjustment
09a6f3668a Jeff*0040       INTEGER i,j   ! loop counters
                0041 C     save below in common block so continual reloading isn't necessary
                0042       COMMON /OCEANMEAN/
                0043      &                 tau0, tau1, tav0, tav1,
                0044      &                 wind0, wind1, qnet0, qnet1,
7ad882c4ff Jeff*0045      &                 evap0, precip0, runoff0
                0046 C     &                 evap0, evap1,
                0047 C     &                 precip0, precip1,
                0048 C     &                 runoff0, runoff1
09a6f3668a Jeff*0049
                0050       _RS  tau0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
9274434acc Jean*0051       _RS  tau1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
                0052       _RS  tav0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
                0053       _RS  tav1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
                0054       _RS  wind0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
09a6f3668a Jeff*0055       _RS  wind1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
9274434acc Jean*0056       _RS  qnet0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
                0057       _RS  qnet1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
                0058       _RS  evap0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
7ad882c4ff Jeff*0059 C      _RS  evap1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
9274434acc Jean*0060       _RS  precip0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
7ad882c4ff Jeff*0061 C      _RS  precip1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
9274434acc Jean*0062       _RS  runoff0(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
7ad882c4ff Jeff*0063 C      _RS  runoff1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,1,1)
09a6f3668a Jeff*0064
                0065       IF (ifTime) THEN
                0066
                0067 C      If the above condition is met then we need to read in
                0068 C      data for the period ahead and the period behind current time.
                0069
                0070         WRITE(*,*) 'S/R FIXED_FLUX_ADD: Reading new data'
                0071         IF ( tauuFile .NE. ' '  ) THEN
                0072           CALL READ_REC_XY_RS( tauuFile,tau0,intime0,
                0073      &                      myIter,myThid )
                0074           CALL READ_REC_XY_RS( tauuFile,tau1,intime1,
                0075      &                      myIter,myThid )
                0076         ENDIF
                0077         IF ( tauvFile .NE. ' '  ) THEN
                0078           CALL READ_REC_XY_RS( tauvFile,tav0,intime0,
                0079      &                      myIter,myThid )
                0080           CALL READ_REC_XY_RS( tauvFile,tav1,intime1,
                0081      &                      myIter,myThid )
                0082         ENDIF
                0083         IF ( windFile .NE. ' '  ) THEN
                0084           CALL READ_REC_XY_RS( windFile,wind0,intime0,
                0085      &                      myIter,myThid )
                0086           CALL READ_REC_XY_RS( windFile,wind1,intime1,
                0087      &                      myIter,myThid )
                0088         ENDIF
                0089         IF ( qnetFile .NE. ' '  ) THEN
                0090           CALL READ_REC_XY_RS( qnetFile,qnet0,intime0,
                0091      &                      myIter,myThid )
                0092           CALL READ_REC_XY_RS( qnetFile,qnet1,intime1,
                0093      &                      myIter,myThid )
                0094         ENDIF
7ad882c4ff Jeff*0095       ENDIF
                0096
                0097       IF (new_mon) THEN
                0098         WRITE(*,*) 'S/R FIXED_FLUX_ADD: Reading new EmPmR files'
09a6f3668a Jeff*0099         IF ( evapFile .NE. ' '  ) THEN
7ad882c4ff Jeff*0100           CALL READ_REC_XY_RS( evapFile,evap0,inMonth,
09a6f3668a Jeff*0101      &                      myIter,myThid )
7ad882c4ff Jeff*0102 C          CALL READ_REC_XY_RS( evapFile,evap1,intime1,
                0103 C     &                      myIter,myThid )
09a6f3668a Jeff*0104         ENDIF
                0105         IF ( precipFile .NE. ' '  ) THEN
7ad882c4ff Jeff*0106           CALL READ_REC_XY_RS( precipFile,precip0,inMonth,
09a6f3668a Jeff*0107      &                      myIter,myThid )
7ad882c4ff Jeff*0108 C          CALL READ_REC_XY_RS( precipFile,precip1,intime1,
                0109 C     &                      myIter,myThid )
09a6f3668a Jeff*0110         ENDIF
                0111         IF ( runoffFile .NE. ' '  ) THEN
7ad882c4ff Jeff*0112           CALL READ_REC_XY_RS( runoffFile,runoff0,inMonth,
09a6f3668a Jeff*0113      &                      myIter,myThid )
7ad882c4ff Jeff*0114 C          CALL READ_REC_XY_RS( runoffFile,runoff1,intime1,
                0115 C     &                      myIter,myThid )
09a6f3668a Jeff*0116         ENDIF
7ad882c4ff Jeff*0117         new_mon = .FALSE.
09a6f3668a Jeff*0118       ENDIF
                0119
                0120
                0121 C--   Interpolate and add to anomaly
                0122       DO j=1,sNy
                0123         DO i=1,sNx
709ddc5d16 Jeff*0124          IF (maskC(i,j,1,1,1).EQ.1.) THEN
09a6f3668a Jeff*0125
                0126           fu_2D(i,j)= fu_2D(i,j) +
                0127      &                (wght0*tau0(i,j,1,1) + wght1*tau1(i,j,1,1))
                0128           fv_2D(i,j)= fv_2D(i,j) +
                0129      &                (wght0*tav0(i,j,1,1) + wght1*tav1(i,j,1,1))
                0130           wspeed_2D(i,j)= wspeed_2D(i,j) +
                0131      &                (wght0*wind0(i,j,1,1) + wght1*wind1(i,j,1,1))
                0132
709ddc5d16 Jeff*0133           qfadj = (wght0*qnet0(i,j,1,1) + wght1*qnet1(i,j,1,1))
                0134           IF ( (qfadj .NE. 0. _d 0) .AND.
                0135      &       (iceMask(i,j,1,1) .LT. 0.999 _d 0)) THEN
                0136                qneto_2D(i,j)= qneto_2D(i,j) + qfadj
                0137      &                / (1. _d 0 - iceMask(i,j,1,1))
                0138           ENDIF
09a6f3668a Jeff*0139
8ad2868148 Jeff*0140 C 9/08/06 assume evap is + in file, thus subtract
09a6f3668a Jeff*0141           IF (useObsEmP) THEN
7ad882c4ff Jeff*0142             evapo_2D(i,j)= -evap0(i,j,1,1)
                0143             precipo_2D(i,j)= precip0(i,j,1,1)
09a6f3668a Jeff*0144             IF (iceMask(i,j,1,1) .NE. 0. _d 0) THEN
7ad882c4ff Jeff*0145               evapi_2D(i,j)= -evap0(i,j,1,1)
                0146               precipi_2D(i,j)= precip0(i,j,1,1)
09a6f3668a Jeff*0147             ENDIF
                0148           ELSE
8ad2868148 Jeff*0149             evapo_2D(i,j)= evapo_2D(i,j) -
7ad882c4ff Jeff*0150      &                evap0(i,j,1,1)
09a6f3668a Jeff*0151             precipo_2D(i,j)= precipo_2D(i,j) +
7ad882c4ff Jeff*0152      &                precip0(i,j,1,1)
09a6f3668a Jeff*0153             IF (iceMask(i,j,1,1) .NE. 0. _d 0) THEN
8ad2868148 Jeff*0154               evapi_2D(i,j)= evapi_2D(i,j) -
7ad882c4ff Jeff*0155      &                evap0(i,j,1,1)
09a6f3668a Jeff*0156               precipi_2D(i,j)= precipi_2D(i,j) +
7ad882c4ff Jeff*0157      &                precip0(i,j,1,1)
09a6f3668a Jeff*0158             ENDIF
                0159           ENDIF
                0160
                0161           IF (useObsRunoff) THEN
7ad882c4ff Jeff*0162               runoff_2D(i,j)= runoff0(i,j,1,1)
09a6f3668a Jeff*0163           ELSE
9274434acc Jean*0164               runoff_2D(i,j)= runoff_2D(i,j) +
7ad882c4ff Jeff*0165      &                runoff0(i,j,1,1)
09a6f3668a Jeff*0166           ENDIF
709ddc5d16 Jeff*0167          ENDIF
09a6f3668a Jeff*0168         ENDDO
                0169       ENDDO
                0170
                0171       RETURN
                0172       END
                0173