/[lmdze]/trunk/Sources/phylmd/initphysto.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/initphysto.f

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/Sources/phylmd/initphysto.f revision 151 by guez, Tue Jun 23 15:14:20 2015 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 dynetat0_m, only: day_ref, annee_ref
29      USE histbeg_totreg_m, ONLY : histbeg_totreg
30      USE histdef_m, ONLY : histdef
31      USE histend_m, ONLY : histend
32      use histsync_m, only: histsync
33      USE histvert_m, ONLY : histvert
34      USE dimens_m
35      USE paramet_m
36      USE comconst
37      USE indicesol
38      USE dimphy
39      use conf_gcm_m
40      USE comgeom
41      USE nr_util, ONLY : pi
42      USE ymds2ju_m
43    
44      IMPLICIT NONE
45    
46      !   Arguments
47      CHARACTER(len=*) infile
48      INTEGER nhoriid, i
49      REAL, INTENT (IN) :: tstep
50      REAL t_ops, t_wrt
51      INTEGER fileid
52      INTEGER nq, l
53      REAL nivsigs(llm)
54    
55      !   Variables locales
56    
57      INTEGER tau0
58      REAL zjulian
59      CHARACTER(len=3) str
60      CHARACTER(len=10) ctrac
61      INTEGER uhoriid, vhoriid, thoriid, zvertiid
62      LOGICAL ok_sync
63      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
64    
65      REAL, INTENT (IN) :: rlon(klon), rlat(klon)
66    
67      !-----------------------------------------------------
68    
69      !  Initialisations
70      str = 'q  '
71      ctrac = 'traceur   '
72      ok_sync = .TRUE.
73    
74      !  Appel a histbeg: creation du fichier netcdf et initialisations
75      !     diverses
76    
77      CALL ymds2ju(annee_ref,1,day_ref,0.0,zjulian)
78      tau0 = 0
79    
80      CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
81      DO i = 1, iim
82         zx_lon(i,1) = rlon(i+1)
83         zx_lon(i,jjm+1) = rlon(i+1)
84      END DO
85      CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
86    
87    
88      CALL histbeg_totreg(infile,zx_lon(:,1),zx_lat(1,:),1,iim,1,jjm+1,tau0, &
89           zjulian,tstep,nhoriid,fileid)
90    
91      !  Appel a histvert pour la grille verticale
92    
93      DO l = 1, llm
94         nivsigs(l) = float(l)
95      END DO
96    
97      CALL histvert(fileid,'sig_s','Niveaux sigma','sigma_level',nivsigs, &
98           zvertiid)
99    
100      !  Appels a histdef pour la definition des variables a sauvegarder
101    
102      CALL histdef(fileid,'phis','Surface geop. height','-',iim,jjm+1,nhoriid, &
103           1,1,1,-99,'once',t_ops,t_wrt)
104    
105      CALL histdef(fileid,'aire','Grid area','-',iim,jjm+1,nhoriid,1,1,1,-99, &
106           'once',t_ops,t_wrt)
107    
108      CALL histdef(fileid,'dtime','tps phys ','s',1,1,nhoriid,1,1,1,-99, &
109           'once',t_ops,t_wrt)
110    
111      CALL histdef(fileid,'istphy','tps stock','s',1,1,nhoriid,1,1,1,-99, &
112           'once',t_ops,t_wrt)
113    
114      ! T
115    
116      CALL histdef(fileid,'t','Temperature','K',iim,jjm+1,nhoriid,llm,1,llm, &
117           zvertiid,'inst(X)',t_ops,t_wrt)
118    
119      CALL histdef(fileid,'mfu','flx m. pan. mt','kg m/s',iim,jjm+1,nhoriid, &
120           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
121    
122      CALL histdef(fileid,'mfd','flx m. pan. des','kg m/s',iim,jjm+1,nhoriid, &
123           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
124    
125    
126      ! en_u
127    
128      CALL histdef(fileid,'en_u','flx ent pan mt','kg m/s',iim,jjm+1,nhoriid, &
129           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
130    
131      CALL histdef(fileid,'de_u','flx det pan mt','kg m/s',iim,jjm+1,nhoriid, &
132           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
133    
134    
135      ! en_d
136    
137      CALL histdef(fileid,'en_d','flx ent pan dt','kg m/s',iim,jjm+1,nhoriid, &
138           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
139    
140    
141    
142      ! de_d
143    
144      CALL histdef(fileid,'de_d','flx det pan dt','kg m/s',iim,jjm+1,nhoriid, &
145           llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
146    
147      ! coefh frac_impa,frac_nucl
148    
149      CALL histdef(fileid,'coefh',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
150           zvertiid,'inst(X)',t_ops,t_wrt)
151    
152      ! abderrahmane le 16 09 02
153      CALL histdef(fileid,'fm_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
154           zvertiid,'inst(X)',t_ops,t_wrt)
155    
156      CALL histdef(fileid,'en_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
157           zvertiid,'inst(X)',t_ops,t_wrt)
158      ! fin aj
159    
160      CALL histdef(fileid,'frac_impa',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
161           zvertiid,'inst(X)',t_ops,t_wrt)
162    
163      CALL histdef(fileid,'frac_nucl',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
164           zvertiid,'inst(X)',t_ops,t_wrt)
165    
166    
167      ! pyu1
168    
169      CALL histdef(fileid,'pyu1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
170           'inst(X)',t_ops,t_wrt)
171    
172    
173      ! pyv1
174    
175      CALL histdef(fileid,'pyv1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
176           'inst(X)',t_ops,t_wrt)
177    
178      CALL histdef(fileid,'ftsol1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
179           'inst(X)',t_ops,t_wrt)
180    
181    
182      ! ftsol2
183    
184      CALL histdef(fileid,'ftsol2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
185           'inst(X)',t_ops,t_wrt)
186    
187    
188      ! ftsol3
189    
190      CALL histdef(fileid,'ftsol3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
191           'inst(X)',t_ops,t_wrt)
192    
193    
194      ! ftsol4
195    
196      CALL histdef(fileid,'ftsol4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
197           'inst(X)',t_ops,t_wrt)
198    
199    
200      ! rain
201    
202      CALL histdef(fileid,'rain',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
203           'inst(X)',t_ops,t_wrt)
204    
205    
206      ! psrf1
207    
208      CALL histdef(fileid,'psrf1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
209           'inst(X)',t_ops,t_wrt)
210    
211    
212      ! psrf2
213    
214      CALL histdef(fileid,'psrf2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
215           'inst(X)',t_ops,t_wrt)
216    
217    
218      ! psrf3
219    
220      CALL histdef(fileid,'psrf3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
221           'inst(X)',t_ops,t_wrt)
222    
223    
224      ! psrf4
225    
226      CALL histdef(fileid,'psrf4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
227           'inst(X)',t_ops,t_wrt)
228    
229      CALL histend(fileid)
230      IF (ok_sync) CALL histsync
231    
232    END SUBROUTINE initphysto
Legend:
Removed from v.30  
changed lines
  Added in v.151
  ViewVC Help
Powered by ViewVC 1.1.21