source: trunk/WRF.COMMON/INTERFACES/dynphy_wrf_mars_lmd/update_outputs_physiq_mod.F

Last change on this file was 2018, checked in by mlefevre, 6 years ago

Added outputs for the generic models
File size: 6.5 KB
Line 
1MODULE update_outputs_physiq_mod
2
3CONTAINS
4
5!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
7SUBROUTINE update_outputs_physiq_surf( &
8            ims,ime,jms,jme,&
9            ips,ipe,jps,jpe,&
10            MARS_MODE,&
11            M_TSURF,M_CO2ICE,&
12            M_H2OICE)
13
14   use surfdat_h, only: tsurf, co2ice, qsurf
15
16   implicit none
17
18   INTEGER, INTENT(IN) :: ims,ime,jms,jme
19   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
20   INTEGER, INTENT(IN) :: MARS_MODE
21   INTEGER :: i,j,subs
22   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
23     M_TSURF,M_CO2ICE,M_H2OICE
24
25   DO j = jps,jpe
26   DO i = ips,ipe
27
28     !-----------------------------------!
29     ! 1D subscript for physics "cursor" !
30     !-----------------------------------!
31     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
32
33     !-------------------------------------------------------!
34     ! Save key variables for restart and output and nesting ! 
35     !-------------------------------------------------------!
36     M_CO2ICE(i,j) = co2ice(subs)
37     M_TSURF(i,j) = tsurf(subs)
38     SELECT CASE (MARS_MODE)
39      CASE (1,11,12)
40        M_H2OICE(i,j) = qsurf(subs,2)  !! see above Tracer at surface
41     END SELECT
42
43   ENDDO
44   ENDDO
45
46END SUBROUTINE update_outputs_physiq_surf
47
48!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
49!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
50SUBROUTINE update_outputs_physiq_soil( &
51            ims,ime,jms,jme,&
52            ips,ipe,jps,jpe,&
53            nsoil,&
54            M_TSOIL)
55
56   use comsoil_h, only: tsoil
57
58   implicit none
59
60   INTEGER, INTENT(IN) :: ims,ime,jms,jme
61   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,nsoil
62   INTEGER :: i,j,subs
63   REAL, DIMENSION( ims:ime, nsoil, jms:jme ), INTENT(INOUT)  :: &
64     M_TSOIL
65
66   DO j = jps,jpe
67   DO i = ips,ipe
68
69     !-----------------------------------!
70     ! 1D subscript for physics "cursor" !
71     !-----------------------------------!
72     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
73
74     !-------------------------------------------------------!
75     ! Save key variables for restart and output and nesting ! 
76     !-------------------------------------------------------!
77     M_TSOIL(i,:,j) = tsoil(subs,:)
78
79   ENDDO
80   ENDDO
81
82END SUBROUTINE update_outputs_physiq_soil
83
84!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
85!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
86SUBROUTINE update_outputs_physiq_rad( &
87            ims,ime,jms,jme,&
88            ips,ipe,jps,jpe,&
89            M_FLUXRAD)
90
91   use dimradmars_mod, only: fluxrad
92
93   implicit none
94
95   INTEGER, INTENT(IN) :: ims,ime,jms,jme
96   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe
97   INTEGER :: i,j,subs
98   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: M_FLUXRAD
99
100   DO j = jps,jpe
101   DO i = ips,ipe
102
103     !-----------------------------------!
104     ! 1D subscript for physics "cursor" !
105     !-----------------------------------!
106     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
107
108     !-------------------------------------------------------!
109     ! Save key variables for restart and output and nesting ! 
110     !-------------------------------------------------------!
111     M_FLUXRAD(i,j) = fluxrad(subs)
112
113   ENDDO
114   ENDDO
115
116END SUBROUTINE update_outputs_physiq_rad
117
118!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
119!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
120SUBROUTINE update_outputs_physiq_turb( &
121            ims,ime,jms,jme,kms,kme,&
122            ips,ipe,jps,jpe,kps,kpe,&
123            M_Q2,M_WSTAR,&
124            HFMAX,ZMAX,USTM,HFX)
125
126   use turb_mod, only: q2,wstar,ustar,sensibFlux,&
127                        hfmax_th,zmax_th
128   implicit none
129
130   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
131   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
132   INTEGER :: i,j,subs
133   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: &
134     M_WSTAR,HFMAX,ZMAX,USTM,HFX
135   REAL, DIMENSION( ims:ime, kms:kme+1, jms:jme ), INTENT(INOUT) :: M_Q2
136
137   DO j = jps,jpe
138   DO i = ips,ipe
139
140     !-----------------------------------!
141     ! 1D subscript for physics "cursor" !
142     !-----------------------------------!
143     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
144
145     !-------------------------------------------------------!
146     ! Save key variables for restart and output and nesting ! 
147     !-------------------------------------------------------!
148     M_Q2(i,kps:kpe+1,j) = q2(subs,:)
149     M_WSTAR(i,j) = wstar(subs)
150
151     !! output only (arrays already in phys modules)
152     HFMAX(i,j) = HFMAX_TH(subs)
153     ZMAX(i,j) = ZMAX_TH(subs)
154     USTM(i,j) = ustar(subs)
155     HFX(i,j) = sensibFlux(subs)
156
157  ENDDO
158  ENDDO
159
160END SUBROUTINE update_outputs_physiq_turb
161
162!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
163!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
164SUBROUTINE update_outputs_physiq_diag( &
165            ims,ime,jms,jme,kms,kme,&
166            ips,ipe,jps,jpe,kps,kpe,&
167            SWDOWNZ,TAU_DUST,QSURFDUST,&
168            MTOT,ICETOT,TAU_ICE,&
169            HR_SW,HR_LW,HR_DYN,DT,DTRAD,&
170            RDUST,VMR_ICE,RICE,&
171            CLOUDFRAC,TOTCLOUDFRAC,&
172            RAIN,SNOW,REEVAP,SURFRAIN,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
173            FLUXSURF_LW,FLXGRD,LSCEZ,H2OICE_REFF,LATENT_HF)
174   
175   USE comm_wrf !! to get fields to be written from physiq
176
177   INTEGER, INTENT(IN) :: ims,ime,jms,jme,kms,kme
178   INTEGER, INTENT(IN) :: ips,ipe,jps,jpe,kps,kpe
179   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: &
180     SWDOWNZ,TAU_DUST,QSURFDUST,&
181     MTOT,ICETOT,TAU_ICE,&
182     TOTCLOUDFRAC,ALBEQ,FLUXTOP_DN,FLUXABS_SW,FLUXTOP_LW,FLUXSURF_SW,&
183     FLUXSURF_LW,FLXGRD,LATENT_HF,REEVAP,SURFRAIN
184   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT ) :: &
185     HR_SW,HR_LW,RDUST,VMR_ICE,RICE,CLOUDFRAC,HR_DYN,DT,DTRAD,RAIN,SNOW,&
186     LSCEZ,H2OICE_REFF
187   INTEGER :: i,j,subs
188
189
190   DO j = jps,jpe
191   DO i = ips,ipe
192
193     !-----------------------------------!
194     ! 1D subscript for physics "cursor" !
195     !-----------------------------------!
196     subs = (j-jps)*(ipe-ips+1)+(i-ips+1)
197
198     !! get diagnostics from physics
199     SWDOWNZ(i,j) = comm_SWDOWNZ(subs)
200     TAU_DUST(i,j) = comm_TAU_DUST(subs)
201     QSURFDUST(i,j) = comm_QSURFDUST(subs)
202     MTOT(i,j) = comm_MTOT(subs)
203     ICETOT(i,j) = comm_ICETOT(subs)
204     TAU_ICE(i,j) = comm_TAU_ICE(subs)
205     HR_SW(i,kps:kpe,j) = comm_HR_SW(subs,kps:kpe)
206     HR_LW(i,kps:kpe,j) = comm_HR_LW(subs,kps:kpe)
207     RDUST(i,kps:kpe,j) = comm_RDUST(subs,kps:kpe)
208     VMR_ICE(i,kps:kpe,j) = comm_VMR_ICE(subs,kps:kpe)
209     RICE(i,kps:kpe,j) = comm_RICE(subs,kps:kpe)
210
211   ENDDO
212   ENDDO
213
214   CALL deallocate_comm_wrf
215
216END SUBROUTINE update_outputs_physiq_diag
217
218END MODULE update_outputs_physiq_mod
219
220
221
Note: See TracBrowser for help on using the repository browser.