/[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.2 by jscott, Tue Aug 22 20:21:38 2006 UTC
# 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    
66              qnet_atm(i,j)= qnet_atm(i,j) +              qnet_atm(i,j)= qnet_atm(i,j) +
67       &          qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &          qneti_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
68       &          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))
69              evap_atm(i,j)= evap_atm(i,j) +              evap_atm(i,j)= evap_atm(i,j) +
70       &          evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &          evapi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
71       &          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))
72              precip_atm(i,j)= precip_atm(i,j) +              precip_atm(i,j)= precip_atm(i,j) +
73       &           precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +       &           precipi_2D(i,j)*dtatmo*iceMask(i,j,1,1) +
74       &           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))
75              runoff_atm(i,j)= runoff_atm(i,j) +              runoff_atm(i,j)= runoff_atm(i,j) +
76       &           runoff_2D(i,j)*dtatmo       &           runoff_2D(i,j)*dtatmo
77  C            time_cum = time_cum + dtatmo  C            time_cum = time_cum + dtatmo
# Line 79  C            time_cum = time_cum + dtatm Line 80  C            time_cum = time_cum + dtatm
80          ENDDO          ENDDO
81        ENDDO        ENDDO
82    
83        PRINT *,'*** bottom calc_1to2d; evapo_2D',evapo_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; evapo_2D',evapo_2D(JBUGI,JBUGJ)
84        PRINT *,'*** bottom calc_1to2d; precipo_2D',precipo_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; precipo_2D',precipo_2D(JBUGI,JBUGJ)
85        PRINT *,'*** bottom calc_1to2d; runoff_2D',runoff_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; runoff_2D',runoff_2D(JBUGI,JBUGJ)
86        PRINT *,'*** bottom calc_1to2d; qneto_2D',qneto_2D(JBUGI,JBUGJ)  C      PRINT *,'*** bottom calc_1to2d; qneto_2D',qneto_2D(JBUGI,JBUGJ)
87    
88        RETURN        RETURN
89        END        END
90    
# Line 131  C     wght  - weight of this atmos cell Line 133  C     wght  - weight of this atmos cell
133    
134        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
135        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
136        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
137          precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j)          precipo_2D(i,j)= precipo_2D(i,j) - evapo_2D(i,j)
138          evapo_2D(i,j)=0.D0          evapo_2D(i,j)=0. _d 0
139        ENDIF        ENDIF
140    
141        IF (iceMask(i,j,1,1).GT.0.D0) THEN        IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
142          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
143          precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt          precipi_2D(i,j)= precipi_2D(i,j) + atm_precip(ind)*wgt
144          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
145          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
146            precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j)            precipi_2D(i,j)= precipi_2D(i,j) - evapi_2D(i,j)
147            evapi_2D(i,j)=0.D0            evapi_2D(i,j)=0. _d 0
148          ENDIF          ENDIF
149          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
150          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 156  C     wght  - weight of this atmos cell
156       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
157          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)*          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocnq(ind)*
158       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
159          IF (iceMask(i,j,1,1).GT.0.D0) THEN          IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
160            qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)*            qneti_2D(i,j)=qneti_2D(i,j)+atm_dFdt_iceq(ind)*
161       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)
162            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 167  C     wght  - weight of this atmos cell
167       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
168          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)*          evapo_2D(i,j)= evapo_2D(i,j) + atm_dLdt_ocn(ind)*
169       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)       &             (sstFromOcn(i,j)-ctocn(ind)*wgt)
170          IF (iceMask(i,j,1,1).GT.0.D0) THEN          IF (iceMask(i,j,1,1) .GT. 0. _d 0) THEN
171            qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)*            qneti_2D(i,j)= qneti_2D(i,j) + atm_dFdt_ice(ind)*
172       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)       &             (Tsrf(i,j,1,1)-ctice(ind)*wgt)
173            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 206  C     LOCAL VARIABLES: Line 208  C     LOCAL VARIABLES:
208        DO i=1,sNx        DO i=1,sNx
209          DO j=1,sNy          DO j=1,sNy
210    
211            precipo_2D(i,j)= 0.D0            precipo_2D(i,j)= 0. _d 0
212            precipi_2D(i,j)= 0.D0            precipi_2D(i,j)= 0. _d 0
213            solarnet_ocn_2D(i,j)= 0.D0            solarnet_ocn_2D(i,j)= 0. _d 0
214            slp_2D(i,j)= 0.D0            slp_2D(i,j)= 0. _d 0
215            pCO2_2D(i,j)= 0.D0            pCO2_2D(i,j)= 0. _d 0
216            wspeed_2D(i,j)= 0.D0            wspeed_2D(i,j)= 0. _d 0
217            fu_2D(i,j)= 0.D0            fu_2D(i,j)= 0. _d 0
218            fv_2D(i,j)= 0.D0            fv_2D(i,j)= 0. _d 0
219            qneto_2D(i,j)= 0.D0            qneto_2D(i,j)= 0. _d 0
220            evapo_2D(i,j)= 0.D0            evapo_2D(i,j)= 0. _d 0
221            qneti_2D(i,j)= 0.D0            qneti_2D(i,j)= 0. _d 0
222            evapi_2D(i,j)= 0.D0            evapi_2D(i,j)= 0. _d 0
223            dFdT_ice_2D(i,j)= 0.D0            dFdT_ice_2D(i,j)= 0. _d 0
224            Tair_2D(i,j)= 0.D0            Tair_2D(i,j)= 0. _d 0
225            solarinc_2D(i,j)= 0.D0            solarinc_2D(i,j)= 0. _d 0
226            runoff_2D(i,j)= 0.D0            runoff_2D(i,j)= 0. _d 0
227    
228          ENDDO          ENDDO
229        ENDDO        ENDDO
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22