/[MITgcm]/MITgcm_contrib/jscott/pkg_atm2d/calc_1dto2d.F
ViewVC logotype

Diff of /MITgcm_contrib/jscott/pkg_atm2d/calc_1dto2d.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jscott, Fri Aug 11 18:55:49 2006 UTC revision 1.3 by jscott, Tue May 1 19:38:47 2007 UTC
# Line 2  Line 2 
2  #include "ATM2D_OPTIONS.h"  #include "ATM2D_OPTIONS.h"
3    
4  C     !INTERFACE:  C     !INTERFACE:
5        SUBROUTINE CALC_1DTO2D( inMonth, myThid )        SUBROUTINE CALC_1DTO2D( myThid )
6  C     *==========================================================*  C     *==========================================================*
7  C     | - Takes 1D atmos data, regrid to 2D ocean grid           |  C     | - Takes 1D atmos data, regrid to 2D ocean grid. This     |
8  c     | |  C     |   involves totalling runoff into bands and redistributing|
9    C     |   and using derivates dF/dT and dH/dT to compute         |
10    C     |   local variations in evap and heat flux.                |
11  C     *==========================================================*  C     *==========================================================*
12          IMPLICIT NONE          IMPLICIT NONE
13    
# Line 22  C     === Atmos/Ocean/Seaice Interface V Line 24  C     === Atmos/Ocean/Seaice Interface V
24    
25  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
26  C     === Routine arguments ===  C     === Routine arguments ===
 C     inMonth - current month (or forcing period)  
27  C     myThid - Thread no. that called this routine.  C     myThid - Thread no. that called this routine.
       INTEGER inMonth  
28        INTEGER myThid        INTEGER myThid
29    
30  C     LOCAL VARIABLES:  C     LOCAL VARIABLES:
31        INTEGER i,j        INTEGER i,j           ! loop counters across ocean grid
32        INTEGER ib,ibj1,ibj2        INTEGER ib,ibj1,ibj2  ! runoff band variables
33        _RL run_b(sNy)        _RL run_b(sNy)        ! total runoff in a band
34    
35        CALL INIT_2DFLD(myThid)        CALL INIT_2DFLD(myThid)
36    
# Line 40  C     Accumulate runoff into bands (runo Line 40  C     Accumulate runoff into bands (runo
40          IF (ib.GT.1) ibj1= rband(ib-1)+1          IF (ib.GT.1) ibj1= rband(ib-1)+1
41          ibj2=sNy          ibj2=sNy
42          IF (ib.LT.numBands) ibj2= rband(ib)          IF (ib.LT.numBands) ibj2= rband(ib)
43          run_b(ib)=0.D0          run_b(ib)=0. _d 0
44          DO j=ibj1,ibj2          DO j=ibj1,ibj2
45            run_b(ib)=run_b(ib)+atm_runoff(atm_oc_ind(j))*atm_oc_wgt(j) +            run_b(ib)=run_b(ib)+atm_runoff(atm_oc_ind(j))*atm_oc_wgt(j) +
46       &              atm_runoff(atm_oc_ind(j)+1)*(1.D0-atm_oc_wgt(j))       &              atm_runoff(atm_oc_ind(j)+1)*(1. _d 0-atm_oc_wgt(j))
47          ENDDO          ENDDO
48        ENDDO        ENDDO
49    
# Line 57  C     Accumulate runoff into bands (runo Line 57  C     Accumulate runoff into bands (runo
57        
58              CALL CALC_WGHT2D(i,j,atm_oc_ind(j),atm_oc_wgt(j))              CALL CALC_WGHT2D(i,j,atm_oc_ind(j),atm_oc_wgt(j))
59    
60              IF (atm_oc_wgt(j).LT.1.D0)              IF (atm_oc_wgt(j).LT.1. _d 0)
61       &          CALL CALC_WGHT2D(i,j,atm_oc_ind(j)+1,1.D0-atm_oc_wgt(j))       &          CALL CALC_WGHT2D(i, j, atm_oc_ind(j)+1,
62         &                           1. _d 0-atm_oc_wgt(j))
63    
64  C  Tabulate following diagnostic fluxes from atmos model only  C  Tabulate following diagnostic fluxes from atmos model only
   
65              qnet_atm(i,j)= qnet_atm(i,j) +              qnet_atm(i,j)= qnet_atm(i,j) +
66       &          qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &          qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
67       &          qneto_2D(i,j)*dtatmo*(1.D0-iceMask(i,j,1,1))       &          qneto_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
68              evap_atm(i,j)= evap_atm(i,j) +              evap_atm(i,j)= evap_atm(i,j) +
69       &          evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &          evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
70       &          evapo_2D(i,j)*dtatmo*(1.D0-iceMask(i,j,1,1))       &          evapo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
71              precip_atm(i,j)= precip_atm(i,j) +              precip_atm(i,j)= precip_atm(i,j) +
72       &           precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &           precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
73       &           precipo_2D(i,j)*dtatmo*(1.D0-iceMask(i,j,1,1))       &           precipo_2D(i,j)*dtatmo*(1. _d 0-iceMask(i,j,1,1))
74              runoff_atm(i,j)= runoff_atm(i,j) +              runoff_atm(i,j)= runoff_atm(i,j) +
75       &           runoff_2D(i,j)*dtatmo       &           runoff_2D(i,j)*dtatmo
 C            time_cum = time_cum + dtatmo  
76            ENDIF            ENDIF
77    
78          ENDDO          ENDDO
79        ENDDO        ENDDO
80    
81        PRINT *,'*** bottom calc_1to2d; evapo_2D',evapo_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; evapo_2D',evapo_2D(JBUGI,JBUGJ)
82        PRINT *,'*** bottom calc_1to2d; precipo_2D',precipo_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; precipo_2D',precipo_2D(JBUGI,JBUGJ)
83        PRINT *,'*** bottom calc_1to2d; runoff_2D',runoff_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; runoff_2D',runoff_2D(JBUGI,JBUGJ)
84        PRINT *,'*** bottom calc_1to2d; qneto_2D',qneto_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; qneto_2D',qneto_2D(JBUGI,JBUGJ)
85    
86        RETURN        RETURN
87        END        END
88    
# Line 95  C--------------------------------------- Line 95  C---------------------------------------
95  C     !INTERFACE:  C     !INTERFACE:
96        SUBROUTINE CALC_WGHT2D( i, j, ind, wgt)        SUBROUTINE CALC_WGHT2D( i, j, ind, wgt)
97  C     *==========================================================*  C     *==========================================================*
98  C     | Use atmos grid cell 1D value and weight to convert to 2D |  C     | Use atmos grid cell 1D value and weight to convert to 2D.|
99  C     | Variations from zonal mean computed used derivative dF/dT|  C     | Variations from zonal mean computed used derivative dH/dT|
100  C     | and dL/dT  for heat flux and evap terms.                 |  C     | and dF/dT  for heat flux and evap terms.                 |
101  C     |                                                          |  C     |                                                          |
102  C     | Fluxes/values over seaice computed only if seaice present|  C     | Fluxes/values over seaice computed only if seaice present|
103  C     *==========================================================*  C     *==========================================================*
# Line 115  C     === Atmos/Ocean/Seaice Interface V Line 115  C     === Atmos/Ocean/Seaice Interface V
115    
116  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
117  C     === Routine arguments ===  C     === Routine arguments ===
118  C     index - index into the atmos grid array  C     i,j   - coordinates of point on ocean grid
119    C     ind   - index into the atmos grid array
120  C     wght  - weight of this atmos cell for total  C     wght  - weight of this atmos cell for total
121        INTEGER    i, j        INTEGER    i, j
122        INTEGER    ind        INTEGER    ind
# Line 131  C     wght  - weight of this atmos cell Line 132  C     wght  - weight of this atmos cell
132    
133        qneto_2D(i,j)= qneto_2D(i,j) + atm_qnet_ocn(ind)*wgt        qneto_2D(i,j)= qneto_2D(i,j) + atm_qnet_ocn(ind)*wgt
134        evapo_2D(i,j)= evapo_2D(i,j) + atm_evap_ocn(ind)*wgt        evapo_2D(i,j)= evapo_2D(i,j) + atm_evap_ocn(ind)*wgt
135        IF (evapo_2D(i,j).GT.0.D0) THEN  !convert negative evap. to precip        IF (evapo_2D(i,j).GT.0. _d 0) THEN  !convert negative evap. to precip
136          precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j)          precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j)
137          evapo_2D(i,j)=0.D0          evapo_2D(i,j)=0. _d 0
138        ENDIF        ENDIF
139    
140        IF (iceMask(i,j,1,1).GT.0.D0) THEN        IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
141          qneti_2D(i,j)= qneti_2D(i,j) + atm_qnet_ice(ind)*wgt          qneti_2D(i,j)= qneti_2D(i,j) + atm_qnet_ice(ind)*wgt
142          precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt          precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt
143          evapi_2D(i,j)= evapi_2D(i,j) + atm_evap_ice(ind)*wgt          evapi_2D(i,j)= evapi_2D(i,j) + atm_evap_ice(ind)*wgt
144          IF (evapi_2D(i,j).GT.0.D0) THEN  !convert negative evap. to precip          IF (evapi_2D(i,j).GT.0. _d 0) THEN  !convert negative evap. to precip
145            precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j)            precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j)
146            evapi_2D(i,j)=0.D0            evapi_2D(i,j)=0. _d 0
147          ENDIF          ENDIF
148          dFdT_ice_2D(i,j)= dFdT_ice_2D(i,j) + atm_dFdT_ice(ind)*wgt          dFdT_ice_2D(i,j)= dFdT_ice_2D(i,j) + atm_dFdT_ice(ind)*wgt
149          Tair_2D(i,j)= Tair_2D(i,j) + atm_Tair(ind)*wgt          Tair_2D(i,j)= Tair_2D(i,j) + atm_Tair(ind)*wgt
# Line 154  C     wght  - weight of this atmos cell Line 155  C     wght  - weight of this atmos cell
155       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
156          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)*          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)*
157       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
158          IF (iceMask(i,j,1,1).GT.0.D0) THEN          IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
159            qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)*            qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)*
160       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)
161            evapi_2D(i,j)=evapi_2D(i,j)+atm_dLdt_iceq(ind)*            evapi_2D(i,j)=evapi_2D(i,j)+atm_dLdt_iceq(ind)*
# Line 165  C     wght  - weight of this atmos cell Line 166  C     wght  - weight of this atmos cell
166       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
167          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)*          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)*
168       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
169          IF (iceMask(i,j,1,1).GT.0.D0) THEN          IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
170            qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)*            qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)*
171       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)
172            evapi_2D(i,j)= evapi_2D(i,j)+atm_dLdt_ice(ind)*            evapi_2D(i,j)= evapi_2D(i,j)+atm_dLdt_ice(ind)*
# Line 185  C--------------------------------------- Line 186  C---------------------------------------
186  C     !INTERFACE:  C     !INTERFACE:
187        SUBROUTINE INIT_2DFLD( myThid)        SUBROUTINE INIT_2DFLD( myThid)
188  C     *==========================================================*  C     *==========================================================*
189  C     | |  C     | Zero out the 2D fields; called prior to doing any of the |
190  c     | |  C     | 1D->2D calculation.                                      |
191  C     *==========================================================*  C     *==========================================================*
192          IMPLICIT NONE          IMPLICIT NONE
193    
# Line 206  C     LOCAL VARIABLES: Line 207  C     LOCAL VARIABLES:
207        DO i=1,sNx        DO i=1,sNx
208          DO j=1,sNy          DO j=1,sNy
209    
210            precipo_2D(i,j)= 0.D0            precipo_2D(i,j)= 0. _d 0
211            precipi_2D(i,j)= 0.D0            precipi_2D(i,j)= 0. _d 0
212            solarnet_ocn_2D(i,j)= 0.D0            solarnet_ocn_2D(i,j)= 0. _d 0
213            slp_2D(i,j)= 0.D0            slp_2D(i,j)= 0. _d 0
214            pCO2_2D(i,j)= 0.D0            pCO2_2D(i,j)= 0. _d 0
215            wspeed_2D(i,j)= 0.D0            wspeed_2D(i,j)= 0. _d 0
216            fu_2D(i,j)= 0.D0            fu_2D(i,j)= 0. _d 0
217            fv_2D(i,j)= 0.D0            fv_2D(i,j)= 0. _d 0
218            qneto_2D(i,j)= 0.D0            qneto_2D(i,j)= 0. _d 0
219            evapo_2D(i,j)= 0.D0            evapo_2D(i,j)= 0. _d 0
220            qneti_2D(i,j)= 0.D0            qneti_2D(i,j)= 0. _d 0
221            evapi_2D(i,j)= 0.D0            evapi_2D(i,j)= 0. _d 0
222            dFdT_ice_2D(i,j)= 0.D0            dFdT_ice_2D(i,j)= 0. _d 0
223            Tair_2D(i,j)= 0.D0            Tair_2D(i,j)= 0. _d 0
224            solarinc_2D(i,j)= 0.D0            solarinc_2D(i,j)= 0. _d 0
225            runoff_2D(i,j)= 0.D0            runoff_2D(i,j)= 0. _d 0
226    
227          ENDDO          ENDDO
228        ENDDO        ENDDO
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22