pkg/atm2d/pass_thsice_fluxes.F

aea46876b4 Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003
                0004 C     !INTERFACE:
                0005       SUBROUTINE PASS_THSICE_FLUXES( myThid )
                0006 C     *==========================================================*
                0007 C     | Called after each atm time step - put Qneti, dF/dT, solar|
                0008 c     | for seaice to use, accumlate precip fluxes for thsice pkg|
                0009 C     *==========================================================*
                0010         IMPLICIT NONE
                0011
                0012 #include "ATMSIZE.h"
                0013 #include "SIZE.h"
                0014 #include "GRID.h"
                0015 #include "EEPARAMS.h"
                0016
                0017 C     === Global SeaIce Variables ===
                0018 #include "THSICE_PARAMS.h"
                0019 #include "THSICE_VARS.h"
                0020
                0021 C     === Atmos/Ocean/Seaice Interface Variables ===
                0022 #include "ATM2D_VARS.h"
                0023
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     === Routine arguments ===
                0027 C     myThid - Thread no. that called this routine.
                0028       INTEGER myThid
                0029
                0030 C     LOCAL VARIABLES:
                0031       INTEGER i,j
                0032
                0033       DO j=1, sNy
                0034        DO i=1, sNx
                0035
9274434acc Jean*0036          IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
aea46876b4 Jeff*0037            netSW(i,j) = solarinc_2D(i,j)*(1. _d 0 - siceAlb(i,j,1,1)) ! convert to netSW
9274434acc Jean*0038            sFlx(i,j,0)= -qneti_2D(i,j) -netSW(i,j) +
aea46876b4 Jeff*0039      &                  Tsrf(i,j,1,1)*dFdT_ice_2D(i,j)
                0040            sFlx(i,j,1)= -qneti_2D(i,j) -netSW(i,j)
                0041            sFlx(i,j,2)= -dFdT_ice_2D(i,j)
                0042
                0043 C          Note conversion to ice model sign convention below
9274434acc Jean*0044            sum_prcIce(i,j) = sum_prcIce(i,j) - precipi_2D(i,j)*rhofw
                0045            sum_evapIce(i,j) = sum_evapIce(i,j) - evapi_2D(i,j)*rhofw
                0046            IF (Tair_2D(i,j) .LE. 0. _d 0)
aea46876b4 Jeff*0047      &      sum_snowPrc(i,j) = sum_snowPrc(i,j) - precipi_2D(i,j)*rhofw
9274434acc Jean*0048
aea46876b4 Jeff*0049          ENDIF
                0050
                0051        ENDDO
9274434acc Jean*0052       ENDDO
aea46876b4 Jeff*0053
                0054
                0055       RETURN
                0056       END