Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:29 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
09a6f3668a Jeff*0001 #include "ctrparam.h"
                0002 #include "ATM2D_OPTIONS.h"
                0003 
                0004 C     !INTERFACE:
                0005       SUBROUTINE CALC_1DTO2D( myThid )
                0006 C     *==========================================================*
                0007 C     | - Takes 1D atmos data, regrid to 2D ocean grid. This     |
                0008 C     |   involves totalling runoff into bands and redistributing|
                0009 C     |   and using derivates dF/dT and dH/dT to compute         |
                0010 C     |   local variations in evap and heat flux.                |
                0011 C     *==========================================================*
                0012         IMPLICIT NONE
                0013 
                0014 #include "ATMSIZE.h"
                0015 #include "SIZE.h"
                0016 #include "GRID.h"
                0017 #include "EEPARAMS.h"
                0018 
                0019 C     === Global SeaIce Variables ===
                0020 #include "THSICE_VARS.h"
                0021 
                0022 C     === Atmos/Ocean/Seaice Interface Variables ===
                0023 #include "ATM2D_VARS.h"
                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           ! loop counters across ocean grid
                0032       INTEGER ib,ibj1,ibj2  ! runoff band variables
                0033       _RL run_b(sNy)        ! total runoff in a band
f67c0bf3c1 Jeff*0034       _RL fv_toC            ! meridional wind stress for ocean C-grid pt
09a6f3668a Jeff*0035 
                0036       CALL INIT_2DFLD(myThid)
                0037 
                0038 C     Accumulate runoff into bands (runoff bands are on the ocean grid)
                0039       DO ib=1,numBands
                0040         ibj1=1
                0041         IF (ib.GT.1) ibj1= rband(ib-1)+1
                0042         ibj2=sNy
                0043         IF (ib.LT.numBands) ibj2= rband(ib)
                0044         run_b(ib)=0. _d 0
                0045         DO j=ibj1,ibj2
9274434acc Jean*0046           run_b(ib)=run_b(ib) +
0efd285817 Jeff*0047      &              atm_runoff(atm_oc_ind(j))*atm_oc_frac1(j) +
                0048      &              atm_runoff(atm_oc_ind(j)+1)*atm_oc_frac2(j)
09a6f3668a Jeff*0049         ENDDO
                0050       ENDDO
9274434acc Jean*0051 
09a6f3668a Jeff*0052       DO j=1,sNy
f67c0bf3c1 Jeff*0053 
                0054 C       do a linear interpolation from atmos data to get tauv
                0055         fv_toC = atm_tauv(tauv_jpt(j)) * tauv_jwght(j) + 
7edba25672 Jeff*0056      &        atm_tauv(tauv_jpt(j)+1) * (1. _d 0 - tauv_jwght(j))
f67c0bf3c1 Jeff*0057     
09a6f3668a Jeff*0058         DO i=1,sNx
                0059 
                0060           IF (maskC(i,j,1,1,1).EQ.1.) THEN
9274434acc Jean*0061 
                0062             runoff_2D(i,j) = run_b(runIndex(j)) *
09a6f3668a Jeff*0063      &                       runoffVal(i,j)/rA(i,j,1,1)
9274434acc Jean*0064 
09a6f3668a Jeff*0065             CALL CALC_WGHT2D(i,j,atm_oc_ind(j),atm_oc_wgt(j))
                0066 
                0067             IF (atm_oc_wgt(j).LT.1. _d 0)
                0068      &          CALL CALC_WGHT2D(i, j, atm_oc_ind(j)+1,
                0069      &                           1. _d 0-atm_oc_wgt(j))
                0070 
f67c0bf3c1 Jeff*0071             fv_2D(i,j) = fv_toC
                0072 
09a6f3668a Jeff*0073 C  Tabulate following diagnostic fluxes from atmos model only
                0074             qnet_atm(i,j)= qnet_atm(i,j) +
                0075      &          qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
                0076      &          qneto_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
                0077             evap_atm(i,j)= evap_atm(i,j) +
                0078      &          evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
                0079      &          evapo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
                0080             precip_atm(i,j)= precip_atm(i,j) +
                0081      &           precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
                0082      &           precipo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
                0083             runoff_atm(i,j)= runoff_atm(i,j) +
                0084      &           runoff_2D(i,j)*dtatmo
0efd285817 Jeff*0085          ENDIF
09a6f3668a Jeff*0086 
                0087         ENDDO
                0088       ENDDO
9274434acc Jean*0089 
09a6f3668a Jeff*0090       RETURN
                0091       END
                0092 
                0093 
                0094 C--------------------------------------------------------------------------
                0095 
                0096 #include "ctrparam.h"
                0097 #include "ATM2D_OPTIONS.h"
                0098 
                0099 C     !INTERFACE:
                0100       SUBROUTINE CALC_WGHT2D( i, j, ind, wgt)
                0101 C     *==========================================================*
                0102 C     | Use atmos grid cell 1D value and weight to convert to 2D.|
                0103 C     | Variations from zonal mean computed used derivative dH/dT|
                0104 C     | and dF/dT  for heat flux and evap terms.                 |
                0105 C     |                                                          |
                0106 C     | Fluxes/values over seaice computed only if seaice present|
                0107 C     *==========================================================*
                0108         IMPLICIT NONE
                0109 
                0110 #include "ATMSIZE.h"
                0111 #include "SIZE.h"
                0112 #include "EEPARAMS.h"
                0113 
                0114 C     === Global SeaIce Variables ===
                0115 #include "THSICE_VARS.h"
                0116 
                0117 C     === Atmos/Ocean/Seaice Interface Variables ===
                0118 #include "ATM2D_VARS.h"
                0119 
                0120 C     !INPUT/OUTPUT PARAMETERS:
                0121 C     === Routine arguments ===
                0122 C     i,j   - coordinates of point on ocean grid
                0123 C     ind   - index into the atmos grid array
                0124 C     wght  - weight of this atmos cell for total
                0125       INTEGER    i, j
9274434acc Jean*0126       INTEGER    ind
09a6f3668a Jeff*0127       _RL        wgt
                0128 
                0129       precipo_2D(i,j)= precipo_2D(i,j) + atm_precip(ind)*wgt
                0130       solarnet_ocn_2D(i,j)=solarnet_ocn_2D(i,j) + atm_solar_ocn(ind)*wgt
                0131       slp_2D(i,j)= slp_2D(i,j) + atm_slp(ind)*wgt
                0132       pCO2_2D(i,j)= pCO2_2D(i,j) + atm_pco2(ind)*wgt
                0133       wspeed_2D(i,j)= wspeed_2D(i,j) + atm_windspeed(ind)*wgt
                0134       fu_2D(i,j)= fu_2D(i,j) + atm_tauu(ind)*wgt
                0135 
                0136       qneto_2D(i,j)= qneto_2D(i,j) + atm_qnet_ocn(ind)*wgt
                0137       evapo_2D(i,j)= evapo_2D(i,j) + atm_evap_ocn(ind)*wgt
                0138       IF (evapo_2D(i,j).GT.0. _d 0) THEN  !convert negative evap. to precip
                0139         precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j)
                0140         evapo_2D(i,j)=0. _d 0
                0141       ENDIF
                0142 
                0143       IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
                0144         qneti_2D(i,j)= qneti_2D(i,j) + atm_qnet_ice(ind)*wgt
                0145         precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt
                0146         evapi_2D(i,j)= evapi_2D(i,j) + atm_evap_ice(ind)*wgt
                0147         IF (evapi_2D(i,j).GT.0. _d 0) THEN  !convert negative evap. to precip
                0148           precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j)
                0149           evapi_2D(i,j)=0. _d 0
                0150         ENDIF
                0151         dFdT_ice_2D(i,j)= dFdT_ice_2D(i,j) + atm_dFdT_ice(ind)*wgt
                0152         Tair_2D(i,j)= Tair_2D(i,j) + atm_Tair(ind)*wgt
                0153         solarinc_2D(i,j)= solarinc_2D(i,j) + atm_solarinc(ind)*wgt
                0154       ENDIF
                0155 
                0156       IF (useAltDeriv) THEN
                0157         qneto_2D(i,j)= qneto_2D(i,j) + atm_dFdt_ocnq(ind)*
0efd285817 Jeff*0158      &             (sstFromOcn(i,j)-ctocn(ind))*wgt
09a6f3668a Jeff*0159         evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)*
0efd285817 Jeff*0160      &             (sstFromOcn(i,j)-ctocn(ind))*wgt
09a6f3668a Jeff*0161         IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
                0162           qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)*
0efd285817 Jeff*0163      &             (Tsrf(i,j,1,1)-ctice(ind))*wgt
09a6f3668a Jeff*0164           evapi_2D(i,j)=evapi_2D(i,j)+atm_dLdt_iceq(ind)*
0efd285817 Jeff*0165      &             (Tsrf(i,j,1,1)-ctice(ind))*wgt
09a6f3668a Jeff*0166         ENDIF
                0167       ELSE
                0168         qneto_2D(i,j)= qneto_2D(i,j) + atm_dFdt_ocn(ind)*
0efd285817 Jeff*0169      &             (sstFromOcn(i,j)-ctocn(ind))*wgt
09a6f3668a Jeff*0170         evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)*
0efd285817 Jeff*0171      &             (sstFromOcn(i,j)-ctocn(ind))*wgt
09a6f3668a Jeff*0172         IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
                0173           qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)*
0efd285817 Jeff*0174      &             (Tsrf(i,j,1,1)-ctice(ind))*wgt
09a6f3668a Jeff*0175           evapi_2D(i,j)= evapi_2D(i,j)+atm_dLdt_ice(ind)*
0efd285817 Jeff*0176      &             (Tsrf(i,j,1,1)-ctice(ind))*wgt
09a6f3668a Jeff*0177         ENDIF
                0178       ENDIF
                0179 
                0180 
                0181       RETURN
                0182       END
                0183 
                0184 C--------------------------------------------------------------------------
                0185 
                0186 #include "ctrparam.h"
                0187 #include "ATM2D_OPTIONS.h"
                0188 
                0189 C     !INTERFACE:
                0190       SUBROUTINE INIT_2DFLD( myThid)
                0191 C     *==========================================================*
                0192 C     | Zero out the 2D fields; called prior to doing any of the |
                0193 C     | 1D->2D calculation.                                      |
                0194 C     *==========================================================*
                0195         IMPLICIT NONE
                0196 
                0197 #include "ATMSIZE.h"
                0198 #include "SIZE.h"
                0199 #include "EEPARAMS.h"
                0200 #include "ATM2D_VARS.h"
                0201 
                0202 C     !INPUT/OUTPUT PARAMETERS:
                0203 C     === Routine arguments ===
                0204 C     myThid - Thread no. that called this routine.
                0205       INTEGER myThid
                0206 
                0207 C     LOCAL VARIABLES:
                0208       INTEGER i,j
                0209 
                0210       DO i=1,sNx
                0211         DO j=1,sNy
                0212 
                0213           precipo_2D(i,j)= 0. _d 0
                0214           precipi_2D(i,j)= 0. _d 0
                0215           solarnet_ocn_2D(i,j)= 0. _d 0
                0216           slp_2D(i,j)= 0. _d 0
                0217           pCO2_2D(i,j)= 0. _d 0
                0218           wspeed_2D(i,j)= 0. _d 0
                0219           fu_2D(i,j)= 0. _d 0
                0220           fv_2D(i,j)= 0. _d 0
                0221           qneto_2D(i,j)= 0. _d 0
                0222           evapo_2D(i,j)= 0. _d 0
                0223           qneti_2D(i,j)= 0. _d 0
                0224           evapi_2D(i,j)= 0. _d 0
                0225           dFdT_ice_2D(i,j)= 0. _d 0
                0226           Tair_2D(i,j)= 0. _d 0
                0227           solarinc_2D(i,j)= 0. _d 0
                0228           runoff_2D(i,j)= 0. _d 0
                0229 
                0230         ENDDO
                0231       ENDDO
                0232 
                0233       RETURN
                0234       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!