pkg/atm2d/sum_ocn_fluxes.F

09a6f3668a Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003
                0004 C     !INTERFACE:
                0005       SUBROUTINE SUM_OCN_FLUXES( myThid )
                0006 C     *==========================================================*
                0007 C     | Sums the atmos-> ocn fluxes. Note the stress reduction   |
                0008 c     | (wind forcing) which occurs as icefract > windice_thres  |
                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_VARS.h"
                0019
                0020 C     === Atmos/Ocean/Seaice Interface Variables ===
                0021 #include "ATM2D_VARS.h"
                0022
                0023 c start phasing out wind stress to ocean at this ice fraction
                0024       _RS windice_thres
9274434acc Jean*0025       PARAMETER ( windice_thres= 0.5 )
09a6f3668a Jeff*0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     === Routine arguments ===
                0029 C     myThid - Thread no. that called this routine.
                0030       INTEGER myThid
                0031
                0032 C     LOCAL VARIABLES:
                0033       INTEGER i,j
                0034
                0035       DO j=1, sNy
                0036         DO i=1,sNx
9274434acc Jean*0037
de0f087055 Jeff*0038           IF (maskC(i,j,1,1,1) .EQ. 1.) THEN
09a6f3668a Jeff*0039
                0040 C         Ad hoc phase out wind stress if sufficient ice coverage
de0f087055 Jeff*0041 C         similar idea as stressReduction used in thsice_main
                0042           IF (iceMask(i,j,1,1) .GT. windice_thres) THEN
                0043
9274434acc Jean*0044            fu_2D(i,j)= fu_2D(i,j) * (1. _d 0 -
de0f087055 Jeff*0045      &          (iceMask(i,j,1,1) + iceMask(i-1,j,1,1)) * 0.5 _d 0 )
                0046      &                 / (1. _d 0 - windice_thres)
                0047            fv_2D(i,j)= fv_2D(i,j) * (1. _d 0 -
                0048      &          (iceMask(i,j,1,1) + iceMask(i,j-1,1,1)) * 0.5 _d 0 )
                0049      &                 / (1. _d 0 - windice_thres)
9274434acc Jean*0050            wspeed_2D(i,j)= wspeed_2D(i,j)
de0f087055 Jeff*0051      &                    * (1. _d 0 - iceMask(i,j,1,1))
                0052      &                    / (1. _d 0 - windice_thres)
09a6f3668a Jeff*0053           ENDIF
                0054
                0055           sum_runoff(i,j)= sum_runoff(i,j) + runoff_2D(i,j)
9274434acc Jean*0056           sum_precip(i,j)= sum_precip(i,j) +
09a6f3668a Jeff*0057      &                     precipo_2D(i,j)*(1. _d 0-iceMask(i,j,1,1))
9274434acc Jean*0058           sum_evap(i,j)= sum_evap(i,j) +
09a6f3668a Jeff*0059      &                   evapo_2D(i,j)*(1. _d 0-iceMask(i,j,1,1))
9274434acc Jean*0060           sum_qnet(i,j)= sum_qnet(i,j) +
09a6f3668a Jeff*0061      &                   qneto_2D(i,j)*(1. _d 0-iceMask(i,j,1,1))
                0062           sum_fu(i,j)= sum_fu(i,j) + fu_2D(i,j)
                0063           sum_fv(i,j)= sum_fv(i,j) + fv_2D(i,j)
                0064           sum_wspeed(i,j)= sum_wspeed(i,j) + wspeed_2D(i,j)
9274434acc Jean*0065           sum_solarnet(i,j)= sum_solarnet(i,j) +
09a6f3668a Jeff*0066      &               solarnet_ocn_2D(i,j)*(1. _d 0-iceMask(i,j,1,1))
                0067           sum_slp(i,j)= sum_slp(i,j) + slp_2D(i,j)
                0068           sum_pCO2(i,j)= sum_pCO2(i,j) + pCO2_2D(i,j)
                0069           ENDIF
                0070         ENDDO
9274434acc Jean*0071       ENDDO
09a6f3668a Jeff*0072
                0073 C      PRINT *,'Sum_ocn_fluxes:',JBUGI,JBUGJ,fu_2D(JBUGI,JBUGJ),
9274434acc Jean*0074 C     &       fv_2D(JBUGI,JBUGJ), runoff_2D(JBUGI,JBUGJ),
09a6f3668a Jeff*0075 C     &       precipo_2D(JBUGI,JBUGJ), evapo_2D(JBUGI,JBUGJ),
                0076 C     &       qneto_2D(JBUGI,JBUGJ)
9274434acc Jean*0077
09a6f3668a Jeff*0078       RETURN
                0079       END