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