/[lmdze]/trunk/libf/phylmd/initphysto.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/initphysto.f90

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

trunk/libf/phylmd/initphysto.f revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC trunk/libf/phylmd/initphysto.f90 revision 39 by guez, Tue Jan 25 15:11:05 2011 UTC
# Line 1  Line 1 
1  !  SUBROUTINE initphysto(infile,rlon,rlat,tstep,t_ops,t_wrt,nq,fileid)
 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32 lmdzadmin Exp $  
 !  
 C  
 C  
       subroutine initphysto  
      .  (infile,  
      .  rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)  
   
       USE calendar  
       use histcom  
       use dimens_m  
       use paramet_m  
       use comconst  
       use indicesol  
       use dimphy  
       use logic  
       use comgeom  
       use serre  
       use temps  
       use ener  
       implicit none  
   
 C  
 C   Routine d'initialisation des ecritures des fichiers histoires LMDZ  
 C   au format IOIPSL  
 C  
 C   Appels succesifs des routines: histbeg  
 C                                  histhori  
 C                                  histver  
 C                                  histdef  
 C                                  histend  
 C  
 C   Entree:  
 C  
 C      infile: nom du fichier histoire a creer  
 C      day0,anne0: date de reference  
 C      tstep: duree du pas de temps en seconde  
 C      t_ops: frequence de l'operation pour IOIPSL  
 C      t_wrt: frequence d'ecriture sur le fichier  
 C      nq: nombre de traceurs  
 C  
 C   Sortie:  
 C      fileid: ID du fichier netcdf cree  
 C      filevid:ID du fichier netcdf pour la grille v  
 C  
 C   L. Fairhead, LMD, 03/99  
 C  
 C =====================================================================  
 C  
 C   Declarations  
   
 C   Arguments  
       character*(*) infile  
       integer*4 nhoriid, i  
       real, intent(in):: tstep  
       real t_ops, t_wrt  
       integer fileid, filevid  
       integer nq,l  
       real nivsigs(llm)  
   
 C   Variables locales  
 C  
       integer tau0  
       real zjulian  
       character*3 str  
       character*10 ctrac  
       integer iq  
       integer uhoriid, vhoriid, thoriid, zvertiid  
       integer ii,jj  
       integer zan, idayref  
       logical ok_sync  
       REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)  
 C  
       REAL, intent(in):: rlon(klon), rlat(klon)  
   
 C  Initialisations  
 C  
       pi = 4. * atan (1.)  
       str='q  '  
       ctrac = 'traceur   '  
       ok_sync= .true.  
 C  
 C  Appel a histbeg: creation du fichier netcdf et initialisations diverses  
 C          
   
       zan = annee_ref  
       idayref = day_ref  
       CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)  
       tau0 = 0  
           
         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)  
          DO i = 1, iim  
             zx_lon(i,1) = rlon(i+1)  
             zx_lon(i,jjm+1) = rlon(i+1)  
          ENDDO  
          CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)  
   
   
       call histbeg_totreg(infile, zx_lon(:,1), zx_lat(1,:),  
      .             1, iim, 1, jjm+1,  
      .             tau0, zjulian, tstep, nhoriid, fileid)  
   
 C  Appel a histvert pour la grille verticale  
 C  
         DO l=1,llm  
             nivsigs(l)=float(l)  
          ENDDO  
           
         write(*,*) 'avant histvert ds initphysto'  
   
       call histvert(fileid, 'sig_s', 'Niveaux sigma',  
      . 'sigma_level',  
      .              llm, nivsigs, zvertiid)  
 C  
 C  Appels a histdef pour la definition des variables a sauvegarder  
 C  
         write(*,*) 'apres histvert ds initphysto'  
   
        CALL histdef(fileid, "phis", "Surface geop. height", "-",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99,  
      .                "once", t_ops, t_wrt)  
 c  
         write(*,*) 'apres phis ds initphysto'  
   
          CALL histdef(fileid, "aire", "Grid area", "-",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99,  
      .                "once", t_ops, t_wrt)  
          write(*,*) 'apres aire ds initphysto'  
   
          CALL histdef(fileid, "dtime", "tps phys ", "s",  
      .                1,1,nhoriid, 1,1,1, -99,  
      .                "once", t_ops, t_wrt)  
           
          CALL histdef(fileid, "istphy", "tps stock", "s",  
      .                1,1,nhoriid, 1,1,1, -99,  
      .                "once", t_ops, t_wrt)  
   
 C T  
 C  
       call histdef(fileid, 't', 'Temperature', 'K',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
         write(*,*) 'apres t ds initphysto'  
 C mfu  
 C  
       call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
         write(*,*) 'apres mfu ds initphysto'  
 C  
 C mfd  
 C  
       call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
   
 C  
 C en_u  
 C  
       call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
                write(*,*) 'apres en_u ds initphysto'  
 C  
 C de_u  
 C  
       call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
   
 C  
 C en_d  
 C  
       call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
 C  
   
 C  
 C de_d  
 C  
       call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
   
 c coefh frac_impa,frac_nucl  
           
         call histdef(fileid, "coefh", " ", " ",  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              "inst(X)", t_ops, t_wrt)  
   
 c abderrahmane le 16 09 02  
         call histdef(fileid, "fm_th", " ", " ",  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              "inst(X)", t_ops, t_wrt)  
   
         call histdef(fileid, "en_th", " ", " ",  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              "inst(X)", t_ops, t_wrt)  
 c fin aj  
           
         write(*,*) 'apres coefh ds initphysto'    
   
         call histdef(fileid, 'frac_impa', ' ', ' ',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
           
         call histdef(fileid, 'frac_nucl', ' ', ' ',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .              'inst(X)', t_ops, t_wrt)  
   
 c  
 c pyu1  
 c  
       CALL histdef(fileid, "pyu1", " ", " ",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99,  
      .                "inst(X)", t_ops, t_wrt)  
   
 c  
 c pyv1  
 c  
         CALL histdef(fileid, "pyv1", " ", " ",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99,  
      .                "inst(X)", t_ops, t_wrt)  
           
         write(*,*) 'apres pyv1 ds initphysto'  
 c  
 c ftsol1  
 c  
         call histdef(fileid, "ftsol1", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .             "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol2  
 c  
         call histdef(fileid, "ftsol2", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .             "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol3  
 c  
         call histdef(fileid, "ftsol3", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol4  
 c  
         call histdef(fileid, "ftsol4", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
           
 c  
 c rain  
 c  
         call histdef(fileid, "rain", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf1  
 c  
         call histdef(fileid, "psrf1", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
           
 c  
 c psrf2  
 c  
         call histdef(fileid, "psrf2", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf3  
 c  
         call histdef(fileid, "psrf3", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf4  
 c  
         call histdef(fileid, "psrf4", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .              "inst(X)", t_ops, t_wrt)  
           
         write(*,*) 'avant histend ds initphysto'          
   
       call histend(fileid)  
 c     if (ok_sync) call histsync(fileid)  
       if (ok_sync) call histsync  
2    
3              ! From phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32
4      !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
5      !   au format IOIPSL
6    
7        return    !   Appels succesifs des routines: histbeg
8        end    !                                  histhori
9      !                                  histver
10      !                                  histdef
11      !                                  histend
12    
13      !   Entree:
14    
15      !      infile: nom du fichier histoire a creer
16      !      day0,anne0: date de reference
17      !      tstep: duree du pas de temps en seconde
18      !      t_ops: frequence de l'operation pour IOIPSL
19      !      t_wrt: frequence d'ecriture sur le fichier
20      !      nq: nombre de traceurs
21    
22      !   Sortie:
23      !      fileid: ID du fichier netcdf cree
24      !      filevid:ID du fichier netcdf pour la grille v
25    
26      !   L. Fairhead, 03/99
27    
28      USE calendar
29      USE histcom
30      USE dimens_m
31      USE paramet_m
32      USE comconst
33      USE indicesol
34      USE dimphy
35      USE logic
36      USE comgeom
37      USE serre
38      USE temps
39      USE ener
40      USE nr_util, ONLY : pi
41    
42      IMPLICIT NONE
43    
44      !   Arguments
45      CHARACTER*(*) infile
46      INTEGER nhoriid, i
47      REAL, INTENT (IN) :: tstep
48      REAL t_ops, t_wrt
49      INTEGER fileid, filevid
50      INTEGER nq, l
51      REAL nivsigs(llm)
52    
53      !   Variables locales
54    
55      INTEGER tau0
56      REAL zjulian
57      CHARACTER*3 str
58      CHARACTER*10 ctrac
59      INTEGER iq
60      INTEGER uhoriid, vhoriid, thoriid, zvertiid
61      INTEGER ii, jj
62      INTEGER zan, idayref
63      LOGICAL ok_sync
64      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
65    
66      REAL, INTENT (IN) :: rlon(klon), rlat(klon)
67    
68      !-----------------------------------------------------
69    
70      !  Initialisations
71      str = 'q  '
72      ctrac = 'traceur   '
73      ok_sync = .TRUE.
74    
75      !  Appel a histbeg: creation du fichier netcdf et initialisations
76      !     diverses
77    
78      zan = annee_ref
79      idayref = day_ref
80      CALL ymds2ju(zan,1,idayref,0.0,zjulian)
81      tau0 = 0
82    
83      CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
84      DO i = 1, iim
85         zx_lon(i,1) = rlon(i+1)
86         zx_lon(i,jjm+1) = rlon(i+1)
87      END DO
88      CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
89    
90    
91      CALL histbeg_totreg(infile,zx_lon(:,1),zx_lat(1,:),1,iim,1,jjm+1,tau0, &
92           zjulian,tstep,nhoriid,fileid)
93    
94      !  Appel a histvert pour la grille verticale
95    
96      DO l = 1, llm
97         nivsigs(l) = float(l)
98      END DO
99    
100      CALL histvert(fileid,'sig_s','Niveaux sigma','sigma_level',llm,nivsigs, &
101           zvertiid)
102    
103      !  Appels a histdef pour la definition des variables a sauvegarder
104    
105      CALL histdef(fileid,'phis','Surface geop. height','-',iim,jjm+1,nhoriid, &
106           1,1,1,-99,'once',t_ops,t_wrt)
107    
108      CALL histdef(fileid,'aire','Grid area','-',iim,jjm+1,nhoriid,1,1,1,-99, &
109           'once',t_ops,t_wrt)
110    
111      CALL histdef(fileid,'dtime','tps phys ','s',1,1,nhoriid,1,1,1,-99, &
112           'once',t_ops,t_wrt)
113    
114      CALL histdef(fileid,'istphy','tps stock','s',1,1,nhoriid,1,1,1,-99, &
115           'once',t_ops,t_wrt)
116    
117      ! T
118    
119      CALL histdef(fileid,'t','Temperature','K',iim,jjm+1,nhoriid,llm,1,llm, &
120           zvertiid,'inst(X)',t_ops,t_wrt)
121    
122      CALL histdef(fileid,'mfu','flx m. pan. mt','kg m/s',iim,jjm+1,nhoriid, &
123           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
124    
125      CALL histdef(fileid,'mfd','flx m. pan. des','kg m/s',iim,jjm+1,nhoriid, &
126           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
127    
128    
129      ! en_u
130    
131      CALL histdef(fileid,'en_u','flx ent pan mt','kg m/s',iim,jjm+1,nhoriid, &
132           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
133    
134      CALL histdef(fileid,'de_u','flx det pan mt','kg m/s',iim,jjm+1,nhoriid, &
135           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
136    
137    
138      ! en_d
139    
140      CALL histdef(fileid,'en_d','flx ent pan dt','kg m/s',iim,jjm+1,nhoriid, &
141           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
142    
143    
144    
145      ! de_d
146    
147      CALL histdef(fileid,'de_d','flx det pan dt','kg m/s',iim,jjm+1,nhoriid, &
148           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
149    
150      ! coefh frac_impa,frac_nucl
151    
152      CALL histdef(fileid,'coefh',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
153           zvertiid,'inst(X)',t_ops,t_wrt)
154    
155      ! abderrahmane le 16 09 02
156      CALL histdef(fileid,'fm_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
157           zvertiid,'inst(X)',t_ops,t_wrt)
158    
159      CALL histdef(fileid,'en_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
160           zvertiid,'inst(X)',t_ops,t_wrt)
161      ! fin aj
162    
163      CALL histdef(fileid,'frac_impa',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
164           zvertiid,'inst(X)',t_ops,t_wrt)
165    
166      CALL histdef(fileid,'frac_nucl',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
167           zvertiid,'inst(X)',t_ops,t_wrt)
168    
169    
170      ! pyu1
171    
172      CALL histdef(fileid,'pyu1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
173           'inst(X)',t_ops,t_wrt)
174    
175    
176      ! pyv1
177    
178      CALL histdef(fileid,'pyv1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
179           'inst(X)',t_ops,t_wrt)
180    
181      CALL histdef(fileid,'ftsol1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
182           'inst(X)',t_ops,t_wrt)
183    
184    
185      ! ftsol2
186    
187      CALL histdef(fileid,'ftsol2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
188           'inst(X)',t_ops,t_wrt)
189    
190    
191      ! ftsol3
192    
193      CALL histdef(fileid,'ftsol3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
194           'inst(X)',t_ops,t_wrt)
195    
196    
197      ! ftsol4
198    
199      CALL histdef(fileid,'ftsol4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
200           'inst(X)',t_ops,t_wrt)
201    
202    
203      ! rain
204    
205      CALL histdef(fileid,'rain',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
206           'inst(X)',t_ops,t_wrt)
207    
208    
209      ! psrf1
210    
211      CALL histdef(fileid,'psrf1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
212           'inst(X)',t_ops,t_wrt)
213    
214    
215      ! psrf2
216    
217      CALL histdef(fileid,'psrf2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
218           'inst(X)',t_ops,t_wrt)
219    
220    
221      ! psrf3
222    
223      CALL histdef(fileid,'psrf3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
224           'inst(X)',t_ops,t_wrt)
225    
226    
227      ! psrf4
228    
229      CALL histdef(fileid,'psrf4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
230           'inst(X)',t_ops,t_wrt)
231    
232      CALL histend(fileid)
233      IF (ok_sync) CALL histsync
234    
235    END SUBROUTINE initphysto

Legend:
Removed from v.30  
changed lines
  Added in v.39

  ViewVC Help
Powered by ViewVC 1.1.21