1 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
2 |
|
|
! Interface pour ecrire en netcdf avec les routines d'enseignement |
3 |
|
|
! iotd de Frederic Hourdin |
4 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
5 |
|
|
|
6 |
|
|
subroutine iophys_ecrit(nom,lllm,titre,unite,px) |
7 |
|
|
|
8 |
|
|
USE mod_phys_lmdz_para, ONLY: klon_omp, is_mpi_root |
9 |
|
|
USE mod_phys_lmdz_transfert_para, ONLY: gather |
10 |
|
|
USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo |
11 |
|
|
IMPLICIT NONE |
12 |
|
|
|
13 |
|
|
|
14 |
|
|
|
15 |
|
|
! Ecriture de variables diagnostiques au choix dans la physique |
16 |
|
|
! dans un fichier NetCDF nomme 'diagfi'. Ces variables peuvent etre |
17 |
|
|
! 3d (ex : temperature), 2d (ex : temperature de surface), ou |
18 |
|
|
! 0d (pour un scalaire qui ne depend que du temps : ex : la longitude |
19 |
|
|
! solaire) |
20 |
|
|
! (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne) |
21 |
|
|
! La periode d'ecriture est donnee par |
22 |
|
|
! "ecritphy " regle dans le fichier de controle de run : run.def |
23 |
|
|
! |
24 |
|
|
! writediagfi peut etre appele de n'importe quelle subroutine |
25 |
|
|
! de la physique, plusieurs fois. L'initialisation et la creation du |
26 |
|
|
! fichier se fait au tout premier appel. |
27 |
|
|
! |
28 |
|
|
! WARNING : les variables dynamique (u,v,t,q,ps) |
29 |
|
|
! sauvees par writediagfi avec une |
30 |
|
|
! date donnee sont legerement differentes que dans le fichier histoire car |
31 |
|
|
! on ne leur a pas encore ajoute de la dissipation et de la physique !!! |
32 |
|
|
! IL est RECOMMANDE d'ajouter les tendance physique a ces variables |
33 |
|
|
! avant l'ecriture dans diagfi (cf. physiq.F) |
34 |
|
|
! |
35 |
|
|
! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4 |
36 |
|
|
! |
37 |
|
|
! parametres (input) : |
38 |
|
|
! ---------- |
39 |
|
|
! unit : unite logique du fichier de sortie (toujours la meme) |
40 |
|
|
! nom : nom de la variable a sortir (chaine de caracteres) |
41 |
|
|
! titre: titre de la variable (chaine de caracteres) |
42 |
|
|
! unite : unite de la variable (chaine de caracteres) |
43 |
|
|
! px : variable a sortir (real 0, 1, 2, ou 3d) |
44 |
|
|
! |
45 |
|
|
!================================================================= |
46 |
|
|
|
47 |
|
|
|
48 |
|
|
! Arguments on input: |
49 |
|
|
integer lllm |
50 |
|
|
character (len=*) :: nom,titre,unite |
51 |
|
|
integer imjmax |
52 |
|
|
parameter (imjmax=100000) |
53 |
|
|
real px(klon_omp,lllm) |
54 |
|
|
real xglo(klon_glo,lllm) |
55 |
|
|
real zx(nbp_lon,nbp_lat,lllm) |
56 |
|
|
|
57 |
|
|
|
58 |
|
|
|
59 |
|
|
CALL Gather(px,xglo) |
60 |
|
|
!$OMP MASTER |
61 |
|
|
IF (is_mpi_root) THEN |
62 |
|
|
CALL Grid1Dto2D_glo(xglo,zx) |
63 |
|
|
call iotd_ecrit(nom,lllm,titre,unite,zx) |
64 |
|
|
ENDIF |
65 |
|
|
!$OMP END MASTER |
66 |
|
|
|
67 |
|
|
return |
68 |
|
|
end |
69 |
|
|
|
70 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
71 |
|
|
! Version avec reindexation pour appeler depuis les routines internes |
72 |
|
|
! à la sous surface |
73 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
74 |
|
|
|
75 |
|
|
|
76 |
|
|
subroutine iophys_ecrit_index(nom,lllm,titre,unite,knon,knindex,px) |
77 |
|
|
|
78 |
|
|
USE mod_phys_lmdz_para, ONLY: klon_omp |
79 |
|
|
USE dimphy, ONLY : klon |
80 |
|
|
USE mod_grid_phy_lmdz, ONLY: klon_glo |
81 |
|
|
IMPLICIT NONE |
82 |
|
|
|
83 |
|
|
! This subroutine returns the sea surface temperature already read from limit.nc |
84 |
|
|
! |
85 |
|
|
|
86 |
|
|
! Arguments on input: |
87 |
|
|
INTEGER lllm |
88 |
|
|
CHARACTER (len=*) :: nom,titre,unite |
89 |
|
|
REAL px(klon_omp,lllm) |
90 |
|
|
INTEGER, INTENT(IN) :: knon ! nomber of points on compressed grid |
91 |
|
|
INTEGER, DIMENSION(klon), INTENT(IN) :: knindex ! grid point number for compressed grid |
92 |
|
|
REAL, DIMENSION(klon,lllm) :: varout |
93 |
|
|
|
94 |
|
|
INTEGER :: i,l |
95 |
|
|
|
96 |
|
|
IF (klon/=klon_omp) THEN |
97 |
|
|
print*,'klon, klon_omp',klon,klon_omp |
98 |
|
|
CALL abort_physic('iophys_ecrit','probleme de dimension parallele',1) |
99 |
|
|
ENDIF |
100 |
|
|
|
101 |
|
|
varout(1:klon,1:lllm)=0. |
102 |
|
|
DO l = 1, lllm |
103 |
|
|
DO i = 1, knon |
104 |
|
|
varout(knindex(i),l) = px(i,l) |
105 |
|
|
END DO |
106 |
|
|
END DO |
107 |
|
|
CALL iophys_ecrit(nom,lllm,titre,unite,varout) |
108 |
|
|
|
109 |
|
|
END SUBROUTINE iophys_ecrit_index |
110 |
|
|
|
111 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
112 |
|
|
SUBROUTINE iophys_ini(timestep) |
113 |
|
|
USE mod_phys_lmdz_para, ONLY: is_mpi_root |
114 |
|
|
USE vertical_layers_mod, ONLY: presnivs |
115 |
|
|
USE regular_lonlat_mod, ONLY: lon_reg, lat_reg |
116 |
|
|
USE dimphy, ONLY: klev |
117 |
|
|
USE mod_grid_phy_lmdz, ONLY: klon_glo |
118 |
|
|
USE time_phylmdz_mod, ONLY : annee_ref, day_ref, day_ini |
119 |
|
|
USE phys_cal_mod, ONLY : calend |
120 |
|
|
|
121 |
|
|
IMPLICIT NONE |
122 |
|
|
|
123 |
|
|
include "YOMCST.h" |
124 |
|
|
!======================================================================= |
125 |
|
|
! |
126 |
|
|
! Auteur: L. Fairhead , P. Le Van, Y. Wanherdrick, F. Forget |
127 |
|
|
! ------- |
128 |
|
|
! |
129 |
|
|
! Objet: |
130 |
|
|
! ------ |
131 |
|
|
! |
132 |
|
|
! 'Initialize' the diagfi.nc file: write down dimensions as well |
133 |
|
|
! as time-independent fields (e.g: geopotential, mesh area, ...) |
134 |
|
|
! |
135 |
|
|
!======================================================================= |
136 |
|
|
!----------------------------------------------------------------------- |
137 |
|
|
! Declarations: |
138 |
|
|
! ------------- |
139 |
|
|
|
140 |
|
|
real pi |
141 |
|
|
INTEGER nlat_eff |
142 |
|
|
INTEGER jour0,mois0,an0 |
143 |
|
|
REAL timestep,t0 |
144 |
|
|
CHARACTER(len=20) :: calendrier |
145 |
|
|
|
146 |
|
|
! Arguments: |
147 |
|
|
! ---------- |
148 |
|
|
|
149 |
|
|
|
150 |
|
|
!$OMP MASTER |
151 |
|
|
IF (is_mpi_root) THEN |
152 |
|
|
|
153 |
|
|
! Bidouille pour gerer le fait que lat_reg contient deux latitudes |
154 |
|
|
! en version uni-dimensionnelle (chose qui pourrait être résolue |
155 |
|
|
! par ailleurs) |
156 |
|
|
IF (klon_glo==1) THEN |
157 |
|
|
nlat_eff=1 |
158 |
|
|
ELSE |
159 |
|
|
nlat_eff=size(lat_reg) |
160 |
|
|
ENDIF |
161 |
|
|
pi=2.*asin(1.) |
162 |
|
|
|
163 |
|
|
! print*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref |
164 |
|
|
! print*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend |
165 |
|
|
|
166 |
|
|
! Attention : les lignes ci dessous supposent un calendrier en 360 jours |
167 |
|
|
! Pourrait être retravaillé |
168 |
|
|
|
169 |
|
|
jour0=day_ref-30*(day_ref/30) |
170 |
|
|
mois0=day_ref/30+1 |
171 |
|
|
an0=annee_ref |
172 |
|
|
!FH BIZARE QUAND 1D ... t0=(day_ini-1)*RDAY |
173 |
|
|
t0=0. |
174 |
|
|
calendrier=calend |
175 |
|
|
if ( calendrier == "earth_360d" ) calendrier="360_day" |
176 |
|
|
|
177 |
|
|
print*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0 |
178 |
|
|
|
179 |
|
|
|
180 |
|
|
call iotd_ini('phys.nc', & |
181 |
|
|
size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier) |
182 |
|
|
ENDIF |
183 |
|
|
!$OMP END MASTER |
184 |
|
|
|
185 |
|
|
END |
186 |
|
|
|
187 |
|
|
#ifdef und |
188 |
|
|
SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit) |
189 |
|
|
IMPLICIT none |
190 |
|
|
|
191 |
|
|
!======================================================================= |
192 |
|
|
INTEGER nfield,nlon,iim,jjmp1, jjm |
193 |
|
|
REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield) |
194 |
|
|
|
195 |
|
|
INTEGER i, n, ig |
196 |
|
|
|
197 |
|
|
jjm = jjmp1 - 1 |
198 |
|
|
DO n = 1, nfield |
199 |
|
|
DO i=1,iim |
200 |
|
|
ecrit(i,n) = fi(1,n) |
201 |
|
|
ecrit(i+jjm*iim,n) = fi(nlon,n) |
202 |
|
|
ENDDO |
203 |
|
|
DO ig = 1, nlon - 2 |
204 |
|
|
ecrit(iim+ig,n) = fi(1+ig,n) |
205 |
|
|
ENDDO |
206 |
|
|
ENDDO |
207 |
|
|
RETURN |
208 |
|
|
END |
209 |
|
|
|
210 |
|
|
#endif |
211 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
212 |
|
|
! Interface pour ecrire en netcdf avec les routines d'enseignement |
213 |
|
|
! iotd de Frederic Hourdin |
214 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
215 |
|
|
|
216 |
|
|
SUBROUTINE iotd_ecrit_seq(nom,lllm,titre,unite,px) |
217 |
|
|
|
218 |
|
|
IMPLICIT NONE |
219 |
|
|
|
220 |
|
|
! px arrive |
221 |
|
|
|
222 |
|
|
INCLUDE "iotd.h" |
223 |
|
|
|
224 |
|
|
|
225 |
|
|
! Arguments on input: |
226 |
|
|
integer lllm |
227 |
|
|
character (len=*) :: nom,titre,unite |
228 |
|
|
integer imjmax |
229 |
|
|
parameter (imjmax=100000) |
230 |
|
|
real px(imjmax*lllm) |
231 |
|
|
real, allocatable :: zx(:,:,:) |
232 |
|
|
integer i,j,l,ijl |
233 |
|
|
|
234 |
|
|
allocate(zx(imax,jmax,lllm)) |
235 |
|
|
|
236 |
|
|
ijl=0 |
237 |
|
|
do l=1,lllm |
238 |
|
|
! Pole nord |
239 |
|
|
ijl=ijl+1 |
240 |
|
|
do i=1,imax |
241 |
|
|
zx(i,1,l)=px(ijl) |
242 |
|
|
enddo |
243 |
|
|
! Grille normale |
244 |
|
|
do j=2,jmax-1 |
245 |
|
|
do i=1,imax |
246 |
|
|
ijl=ijl+1 |
247 |
|
|
zx(i,j,l)=px(ijl) |
248 |
|
|
enddo |
249 |
|
|
enddo |
250 |
|
|
! Pole sud |
251 |
|
|
if ( jmax > 1 ) then |
252 |
|
|
ijl=ijl+1 |
253 |
|
|
do i=1,imax |
254 |
|
|
zx(i,jmax,l)=px(ijl) |
255 |
|
|
enddo |
256 |
|
|
endif |
257 |
|
|
enddo |
258 |
|
|
|
259 |
|
|
call iotd_ecrit(nom,lllm,titre,unite,zx) |
260 |
|
|
deallocate(zx) |
261 |
|
|
|
262 |
|
|
return |
263 |
|
|
end |
264 |
|
|
|