source: dynamico_lmdz/aquaplanet/LMDZ5/libf/phylmd/initphysto.F90 @ 3818

Last change on this file since 3818 was 3818, checked in by millour, 10 years ago

Some partial cleanup on uses of "dimensions.h" in physics.
At this point 3D gcm compiles and bench seems to run fine :-)
EM

File size: 6.9 KB
Line 
1!
2! $Id: initphysto.F90 1907 2013-11-26 13:10:46Z lguez $
3!
4SUBROUTINE initphysto(infile,tstep,t_ops,t_wrt,fileid)
5 
6  USE dimphy
7  USE mod_phys_lmdz_para
8  USE IOIPSL
9  USE iophy
10  !USE control_phy_mod
11  USE indice_sol_mod
12  !USE comconst_phy_mod
13  !USE temps_phy_mod
14  USE inifis_mod, ONLY: day_ref, annee_ref
15  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev
16 
17  IMPLICIT NONE
18
19!
20!   Routine d'initialisation des ecritures des fichiers histoires LMDZ
21!   au format IOIPSL
22!
23!   Appels succesifs des routines: histbeg
24!                                  histhori
25!                                  histver
26!                                  histdef
27!                                  histend
28!
29!   Entree:
30!
31!      infile: nom du fichier histoire a creer
32!      day0,anne0: date de reference
33!      tstep: duree du pas de temps en seconde
34!      t_ops: frequence de l'operation pour IOIPSL
35!      t_wrt: frequence d'ecriture sur le fichier
36!
37!   Sortie:
38!      fileid: ID du fichier netcdf cree
39!
40!   L. Fairhead, LMD, 03/99
41!
42! =====================================================================
43!
44!   Declarations
45  INCLUDE "description.h"
46
47!   Arguments
48  CHARACTER(len=*), INTENT(IN) :: infile
49  REAL, INTENT(IN)             :: tstep
50  REAL, INTENT(IN)             :: t_ops
51  REAL, INTENT(IN)             :: t_wrt
52  INTEGER, INTENT(OUT)         :: fileid
53
54! Variables locales
55  INTEGER nhoriid, i
56  INTEGER l,k
57  REAL nivsigs(nbp_lev)
58  INTEGER tau0
59  REAL zjulian
60  INTEGER iq
61  INTEGER uhoriid, vhoriid, thoriid, zvertiid
62  INTEGER ii,jj
63  INTEGER zan, idayref
64  LOGICAL ok_sync
65  REAL zx_lon(nbp_lon,nbp_lat), zx_lat(nbp_lon,nbp_lat)
66  CHARACTER(len=12) :: nvar
67
68!  Initialisations
69!
70  ok_sync= .TRUE.
71!
72!  Appel a histbeg: creation du fichier netcdf et initialisations diverses
73!         
74
75  zan = annee_ref
76  idayref = day_ref
77  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
78  tau0 = 0
79 
80  CALL histbeg_phy(infile,tau0, zjulian, tstep, &
81       nhoriid, fileid)
82
83!$OMP MASTER   
84!  Appel a histvert pour la grille verticale
85!
86  DO l=1,nbp_lev
87     nivsigs(l)=REAL(l)
88  ENDDO
89 
90  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', &
91       'sigma_level', &
92       nbp_lev, nivsigs, zvertiid)
93!
94!  Appels a histdef pour la definition des variables a sauvegarder
95!
96  CALL histdef(fileid, "phis", "Surface geop. height", "-", &
97       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
98       "once", t_ops, t_wrt)
99 
100  CALL histdef(fileid, "aire", "Grid area", "-", &
101       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
102       "once", t_ops, t_wrt)
103
104  CALL histdef(fileid, "longitudes", "longitudes", "-", &
105       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
106       "once", t_ops, t_wrt)
107
108  CALL histdef(fileid, "latitudes", "latitudes", "-", &
109       nbp_lon,jj_nb,nhoriid, 1,1,1, -99, 32, &
110       "once", t_ops, t_wrt)
111! T
112  CALL histdef(fileid, 't', 'Temperature', 'K', nbp_lon, jj_nb, nhoriid, &
113       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
114! mfu
115  CALL histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
116       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
117! mfd
118  CALL histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
119       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
120! en_u
121  CALL histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
122       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
123! de_u
124  CALL histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',nbp_lon, jj_nb, nhoriid, &
125       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
126! en_d
127  CALL histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
128       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
129! de_d
130  CALL histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', nbp_lon, jj_nb, nhoriid, &
131       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
132! coefh
133  CALL histdef(fileid, "coefh", " ", " ", nbp_lon, jj_nb, nhoriid, &
134       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
135! fm_th
136  CALL histdef(fileid, "fm_th", " ", " ",nbp_lon, jj_nb, nhoriid, &
137       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
138! en_th
139  CALL histdef(fileid, "en_th", " ", " ",nbp_lon, jj_nb, nhoriid, &
140       nbp_lev, 1, nbp_lev, zvertiid,32, "inst(X)", t_ops, t_wrt)
141! frac_impa
142  CALL histdef(fileid, 'frac_impa', ' ', ' ',nbp_lon, jj_nb, nhoriid, &
143       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
144! frac_nucl
145  CALL histdef(fileid, 'frac_nucl', ' ', ' ',nbp_lon, jj_nb, nhoriid, &
146       nbp_lev, 1, nbp_lev, zvertiid,32, 'inst(X)', t_ops, t_wrt)
147! pyu1
148  CALL histdef(fileid, "pyu1", " ", " ", nbp_lon,jj_nb,nhoriid, &
149       1,1,1, -99, 32, "inst(X)", t_ops, t_wrt)
150! pyv1
151  CALL histdef(fileid, "pyv1", " ", " ", nbp_lon,jj_nb,nhoriid, &
152       1,1,1, -99, 32,"inst(X)", t_ops, t_wrt)   
153! ftsol1
154  CALL histdef(fileid, "ftsol1", " ", " ",nbp_lon, jj_nb, nhoriid, &
155       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
156! ftsol2
157  CALL histdef(fileid, "ftsol2", " ", " ",nbp_lon, jj_nb, nhoriid, &
158       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
159! ftsol3
160  CALL histdef(fileid, "ftsol3", " ", " ", nbp_lon, jj_nb, nhoriid, &
161       1, 1,1, -99,32, "inst(X)", t_ops, t_wrt)
162! ftsol4
163  CALL histdef(fileid, "ftsol4", " ", " ",nbp_lon, jj_nb, nhoriid, &
164       1, 1,1, -99, 32, "inst(X)", t_ops, t_wrt)
165! psrf1
166  CALL histdef(fileid, "psrf1", " ", " ",nbp_lon, jj_nb, nhoriid, &
167       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
168! psrf2
169  CALL histdef(fileid, "psrf2", " ", " ",nbp_lon, jj_nb, nhoriid, &
170       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
171! psrf3
172  CALL histdef(fileid, "psrf3", " ", " ",nbp_lon, jj_nb, nhoriid, &
173       1, 1, 1, -99, 32, "inst(X)", t_ops, t_wrt)
174! psrf4
175  CALL histdef(fileid, "psrf4", " ", " ", nbp_lon, jj_nb, nhoriid, &
176       1, 1, 1, -99,32, "inst(X)", t_ops, t_wrt)
177! sh
178  CALL histdef(fileid, 'sh', '', '', nbp_lon, jj_nb, nhoriid, &
179       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
180! da
181  CALL histdef(fileid, 'da', '', '', nbp_lon, jj_nb, nhoriid, &
182       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
183! mp
184  CALL histdef(fileid, 'mp', '', '', nbp_lon, jj_nb, nhoriid, &
185       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
186! upwd
187  CALL histdef(fileid, 'upwd', '', '', nbp_lon, jj_nb, nhoriid, &
188       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
189! dnwd
190  CALL histdef(fileid, 'dnwd', '', '', nbp_lon, jj_nb, nhoriid, &
191       nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
192
193! phi
194  DO k=1,nbp_lev
195     IF (k<10) THEN
196        WRITE(nvar,'(i1)') k
197     ELSE IF (k<100) THEN
198        WRITE(nvar,'(i2)') k
199     ELSE
200        WRITE(nvar,'(i3)') k
201     END IF
202     nvar='phi_lev'//trim(nvar)
203     
204     CALL histdef(fileid, nvar, '', '', nbp_lon, jj_nb, nhoriid, &
205          nbp_lev, 1, nbp_lev, zvertiid, 32, 'inst(X)', t_ops, t_wrt)
206  END DO
207
208  CALL histend(fileid)
209  IF (ok_sync) CALL histsync
210!$OMP END MASTER
211       
212END SUBROUTINE initphysto
Note: See TracBrowser for help on using the repository browser.