pkg/atm2d/calc_zonal_means.F

09a6f3668a Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003
                0004 C     !INTERFACE:
b6a1ae81d9 Jeff*0005       SUBROUTINE CALC_ZONAL_MEANS(doAll, myTime, myIter, myThid )
09a6f3668a Jeff*0006 C     *==========================================================*
                0007 C     | Calculate zonal mean ocean quantities (at a specific     |
                0008 C     | point in time). If first argument is false, only seaice  |
                0009 C     | means are calculated, i.e. called after an atm timestep. |
                0010 C     *==========================================================*
                0011         IMPLICIT NONE
                0012
                0013 C     === Global Atmosphere Variables ===
                0014 #include "ATMSIZE.h"
                0015 #include "AGRID.h"
                0016
                0017 C     === Global Ocean Variables ===
                0018 #include "SIZE.h"
                0019 #include "GRID.h"
                0020 #include "EEPARAMS.h"
                0021
d9bcdac665 Jean*0022 C     === Global SeaIce Variables ===
09a6f3668a Jeff*0023 #include "THSICE_VARS.h"
b6a1ae81d9 Jeff*0024       INTEGER siLo, siHi, sjLo, sjHi
                0025       PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx )
                0026       PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy )
09a6f3668a Jeff*0027
                0028 C     === Atmos/Ocean/Seaice Interface Variables ===
                0029 #include "ATM2D_VARS.h"
                0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     === Routine arguments ===
                0033 C     doAll   - boolean, false -> only vars changed after atm step
b6a1ae81d9 Jeff*0034 C     myTime - current simulation time (ocean model time)
                0035 C     myIter - iteration number (ocean model)
09a6f3668a Jeff*0036 C     myThid  - Thread no. that called this routine.
                0037       LOGICAL doAll
b6a1ae81d9 Jeff*0038       _RL     myTime
                0039       INTEGER myIter
09a6f3668a Jeff*0040       INTEGER myThid
                0041
                0042 C     LOCAL VARIABLES:
                0043       _RL mWgt       ! weight of ocean point j+1
                0044       INTEGER i,j    ! loop counters for the ocean grid
                0045       INTEGER j_atm  ! loop counter for the atm grid
                0046
                0047       DO j_atm=1,jm0
                0048         IF (doAll) THEN
                0049           ctocn(j_atm)=0. _d 0
                0050           cfice(j_atm)=0. _d 0
                0051           cco2flux(j_atm)=0. _d 0
                0052         ENDIF
                0053         ctice(j_atm)=0. _d 0
                0054         csAlb(j_atm)=0. _d 0
4c68669c3b Jeff*0055         csAlbNIR(j_atm)=0. _d 0
09a6f3668a Jeff*0056       ENDDO
d9bcdac665 Jean*0057
b6a1ae81d9 Jeff*0058        CALL THSICE_ALBEDO(
                0059      I          1, 1, siLo, siHi, sjLo, sjHi,
                0060      I          1, sNx, 1, sNy,
                0061      I          iceMask(siLo,sjLo,1,1), iceHeight(siLo,sjLo,1,1),
                0062      I          snowHeight(siLo,sjLo,1,1), Tsrf(siLo,sjLo,1,1),
                0063      I          snowAge(siLo,sjLo,1,1),
4c68669c3b Jeff*0064      O          siceAlb(siLo,sjLo,1,1), icAlbNIR(siLo,sjLo,1,1),
b6a1ae81d9 Jeff*0065      I          myTime, myIter, myThid )
                0066
09a6f3668a Jeff*0067       DO j=1,sNy
                0068        DO i=1,sNx
                0069
                0070          IF (maskC(i,j,1,1,1).EQ.1.) THEN
                0071
                0072            IF (doAll) THEN
d9bcdac665 Jean*0073              ctocn(atm_oc_ind(j))= ctocn(atm_oc_ind(j)) +
                0074      &                             sstFromOcn(i,j) * rA(i,j,1,1) *
09a6f3668a Jeff*0075      &                      (1. _d 0-iceMask(i,j,1,1))*atm_oc_wgt(j)
d9bcdac665 Jean*0076              cfice(atm_oc_ind(j))=cfice(atm_oc_ind(j)) +
09a6f3668a Jeff*0077      &              rA(i,j,1,1)*iceMask(i,j,1,1)*atm_oc_wgt(j)
d9bcdac665 Jean*0078              cco2flux(atm_oc_ind(j))=cco2flux(atm_oc_ind(j)) +
07038f52c0 Jeff*0079      &                  oFluxCO2(i,j)*rA(i,j,1,1)*atm_oc_wgt(j)
09a6f3668a Jeff*0080            ENDIF
                0081            ctice(atm_oc_ind(j))=ctice(atm_oc_ind(j)) + Tsrf(i,j,1,1)
                0082      &             *rA(i,j,1,1)*iceMask(i,j,1,1)*atm_oc_wgt(j)
                0083            csAlb(atm_oc_ind(j))=csAlb(atm_oc_ind(j)) + siceAlb(i,j,1,1)
b6a1ae81d9 Jeff*0084      &             *rA(i,j,1,1)*iceMask(i,j,1,1)*atm_oc_wgt(j)
4c68669c3b Jeff*0085            csAlbNIR(atm_oc_ind(j))=csAlbNIR(atm_oc_ind(j)) +
                0086      &             icAlbNIR(i,j,1,1)
                0087      &             *rA(i,j,1,1)*iceMask(i,j,1,1)*atm_oc_wgt(j)
b6a1ae81d9 Jeff*0088
09a6f3668a Jeff*0089
                0090            IF (atm_oc_wgt(j).LT.1. _d 0) THEN
                0091              mWgt= 1. _d 0-atm_oc_wgt(j)
                0092              IF (doAll) THEN
d9bcdac665 Jean*0093                ctocn(atm_oc_ind(j)+1)= ctocn(atm_oc_ind(j)+1) +
                0094      &                                 sstFromOcn(i,j) * rA(i,j,1,1) *
09a6f3668a Jeff*0095      &                                 (1. _d 0-iceMask(i,j,1,1))*mWgt
d9bcdac665 Jean*0096                cfice(atm_oc_ind(j)+1)= cfice(atm_oc_ind(j)+1) +
09a6f3668a Jeff*0097      &             rA(i,j,1,1)*iceMask(i,j,1,1)*mWgt
d9bcdac665 Jean*0098                cco2flux(atm_oc_ind(j)+1)= cco2flux(atm_oc_ind(j)+1) +
07038f52c0 Jeff*0099      &                  oFluxCO2(i,j)*rA(i,j,1,1)*mWgt
09a6f3668a Jeff*0100              ENDIF
d9bcdac665 Jean*0101              ctice(atm_oc_ind(j)+1)= ctice(atm_oc_ind(j)+1) +
09a6f3668a Jeff*0102      &             Tsrf(i,j,1,1)*rA(i,j,1,1)*iceMask(i,j,1,1)*mWgt
d9bcdac665 Jean*0103              csAlb(atm_oc_ind(j)+1)= csAlb(atm_oc_ind(j)+1) +
b6a1ae81d9 Jeff*0104      &             siceAlb(i,j,1,1)*rA(i,j,1,1)*iceMask(i,j,1,1)*mWgt
4c68669c3b Jeff*0105              csAlbNIR(atm_oc_ind(j)+1)= csAlbNIR(atm_oc_ind(j)+1) +
                0106      &             icAlbNIR(i,j,1,1)*rA(i,j,1,1)*iceMask(i,j,1,1)*mWgt
09a6f3668a Jeff*0107            ENDIF
                0108
                0109          ENDIF
                0110
                0111        ENDDO
                0112       ENDDO
                0113
                0114       DO j_atm=2,jm0-1
d9bcdac665 Jean*0115
09a6f3668a Jeff*0116         IF (ocnArea(j_atm).GT.1. _d -32) THEN
d9bcdac665 Jean*0117
                0118           IF (doAll)
120cbb7fd3 Jeff*0119      &      cfice(j_atm)= cfice(j_atm)/ocnArea(j_atm)
09a6f3668a Jeff*0120           IF (cfice(j_atm).GT.1. _d -32) THEN
                0121             ctice(j_atm)= ctice(j_atm)/ocnArea(j_atm)/cfice(j_atm)
                0122             csAlb(j_atm)= csAlb(j_atm)/ocnArea(j_atm)/cfice(j_atm)
4c68669c3b Jeff*0123             csAlbNIR(j_atm)= csAlbNIR(j_atm)/ocnArea(j_atm)/cfice(j_atm)
09a6f3668a Jeff*0124           ENDIF
                0125
d9bcdac665 Jean*0126           IF ((1. _d 0-cfice(j_atm).GT.1. _d -32).AND.doAll)
09a6f3668a Jeff*0127      &        ctocn(j_atm)= ctocn(j_atm)/ocnArea(j_atm)
                0128      &                        /(1. _d 0-cfice(j_atm))
                0129
                0130         ENDIF
d9bcdac665 Jean*0131
09a6f3668a Jeff*0132 C       At present, keeping separate variables in AGRID.h and ATM2D_VARS.h
                0133
                0134         IF (doALL) THEN
                0135           mmsst(j_atm)= ctocn(j_atm)
                0136           mmfice(j_atm)= cfice(j_atm)
                0137           mmco2flux(j_atm)= cco2flux(j_atm)
                0138         ENDIF
                0139         mmtice(j_atm)= ctice(j_atm)
                0140         mmsAlb(j_atm)= csAlb(j_atm)
4c68669c3b Jeff*0141         mmsAlbNIR(j_atm)= csAlbNIR(j_atm)
d9bcdac665 Jean*0142
09a6f3668a Jeff*0143       ENDDO
                0144
                0145 C     Copy data to atmosphere polar points
                0146       IF (doALL) THEN
                0147           mmsst(1)= ctocn(2)
                0148           mmsst(jm0)= ctocn(jm0-1)
                0149           mmfice(1)= cfice(2)
                0150           mmfice(jm0)= cfice(jm0-1)
d9bcdac665 Jean*0151           mmco2flux(1)= 0. _d 0
120cbb7fd3 Jeff*0152           mmco2flux(jm0)= 0. _d 0 ! converted to mol/s; pole point contribution in jm0-1
09a6f3668a Jeff*0153       ENDIF
                0154         mmtice(1)= ctice(2)
                0155         mmtice(jm0)= ctice(jm0-1)
                0156         mmsAlb(1)= csAlb(2)
                0157         mmsAlb(jm0)= csAlb(jm0-1)
4c68669c3b Jeff*0158         mmsAlbNIR(1)= csAlbNIR(2)
                0159         mmsAlbNIR(jm0)= csAlbNIR(jm0-1)
09a6f3668a Jeff*0160
                0161       RETURN
                0162       END