/[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 12 by guez, Mon Jul 21 16:05:07 2008 UTC trunk/Sources/phylmd/initphysto.f revision 190 by guez, Thu Apr 14 15:15:56 2016 UTC
# Line 1  Line 1 
1  !  module initphysto_m
 ! $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 IOIPSL  
   
       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, iim, zx_lon(:,1), jjm+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, 32,  
      .                "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, 32,  
      .                "once", t_ops, t_wrt)  
          write(*,*) 'apres aire ds initphysto'  
   
          CALL histdef(fileid, "dtime", "tps phys ", "s",  
      .                1,1,nhoriid, 1,1,1, -99, 32,  
      .                "once", t_ops, t_wrt)  
           
          CALL histdef(fileid, "istphy", "tps stock", "s",  
      .                1,1,nhoriid, 1,1,1, -99, 32,  
      .                "once", t_ops, t_wrt)  
   
 C T  
 C  
       call histdef(fileid, 't', 'Temperature', 'K',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .             32, '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,  
      .             32, '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,  
      .             32, '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,  
      .             32, '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,  
      .             32, '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,  
      .             32, '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,  
      .             32, 'inst(X)', t_ops, t_wrt)  
   
 c coefh frac_impa,frac_nucl  
           
         call histdef(fileid, "coefh", " ", " ",  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .             32, "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,  
      .             32, "inst(X)", t_ops, t_wrt)  
   
         call histdef(fileid, "en_th", " ", " ",  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .             32, "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,  
      .             32, 'inst(X)', t_ops, t_wrt)  
           
         call histdef(fileid, 'frac_nucl', ' ', ' ',  
      .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
   
 c  
 c pyu1  
 c  
       CALL histdef(fileid, "pyu1", " ", " ",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,  
      .                "inst(X)", t_ops, t_wrt)  
   
 c  
 c pyv1  
 c  
         CALL histdef(fileid, "pyv1", " ", " ",  
      .                iim,jjm+1,nhoriid, 1,1,1, -99, 32,  
      .                "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,32,  
      .             "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol2  
 c  
         call histdef(fileid, "ftsol2", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,32,  
      .             "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol3  
 c  
         call histdef(fileid, "ftsol3", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
   
 c  
 c ftsol4  
 c  
         call histdef(fileid, "ftsol4", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
           
 c  
 c rain  
 c  
         call histdef(fileid, "rain", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1,1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf1  
 c  
         call histdef(fileid, "psrf1", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
           
 c  
 c psrf2  
 c  
         call histdef(fileid, "psrf2", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf3  
 c  
         call histdef(fileid, "psrf3", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .             32, "inst(X)", t_ops, t_wrt)  
   
 c  
 c psrf4  
 c  
         call histdef(fileid, "psrf4", " ", " ",  
      .             iim, jjm+1, nhoriid, 1, 1, 1, -99,  
      .             32, "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              IMPLICIT NONE
4    
5        return  contains
6        end  
7      SUBROUTINE initphysto(infile, tstep, t_ops, t_wrt, fileid)
8    
9        ! From phylmd/initphysto.F, v 1.2 2004/06/22 11:45:32
10    
11        ! Routine d'initialisation des ecritures des fichiers histoires LMDZ
12        ! au format IOIPSL
13    
14        ! L. Fairhead, 03/99
15    
16        use dynetat0_m, only: day_ref, annee_ref, rlatu, rlonv
17        USE histbeg_totreg_m, ONLY : histbeg_totreg
18        USE histdef_m, ONLY : histdef
19        USE histend_m, ONLY : histend
20        use histsync_m, only: histsync
21        USE histvert_m, ONLY : histvert
22        USE dimens_m, only: iim, jjm, llm
23        use nr_util, only: pi
24        USE ymds2ju_m, only: ymds2ju
25    
26        ! Entree:
27    
28        ! infile: nom du fichier histoire a creer
29        ! day0, anne0: date de reference
30        ! tstep: duree du pas de temps en seconde
31        ! t_ops: frequence de l'operation pour IOIPSL
32        ! t_wrt: frequence d'ecriture sur le fichier
33    
34        ! Sortie:
35        ! fileid: ID du fichier netcdf cree
36        ! filevid:ID du fichier netcdf pour la grille v
37    
38        ! Arguments
39        CHARACTER(len=*) infile
40        INTEGER nhoriid
41        REAL, INTENT (IN) :: tstep
42        REAL t_ops, t_wrt
43        INTEGER fileid
44        INTEGER l
45        REAL nivsigs(llm)
46    
47        ! Variables locales
48    
49        INTEGER tau0
50        REAL zjulian
51        INTEGER zvertiid
52        LOGICAL ok_sync
53    
54        !-----------------------------------------------------
55    
56        ! Initialisations
57        ok_sync = .TRUE.
58    
59        ! Appel a histbeg: creation du fichier netcdf et initialisations
60        ! diverses
61    
62        CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
63        tau0 = 0
64    
65        CALL histbeg_totreg(infile, rlonv(:iim) / pi * 180., rlatu / pi * 180., &
66             1, iim, 1, jjm+1, tau0, zjulian, tstep, nhoriid, fileid)
67    
68        ! Appel a histvert pour la grille verticale
69    
70        DO l = 1, llm
71           nivsigs(l) = float(l)
72        END DO
73    
74        CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
75             zvertiid)
76    
77        ! Appels a histdef pour la definition des variables a sauvegarder
78    
79        CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iim, jjm+1, nhoriid, &
80             1, 1, 1, -99, 'once', t_ops, t_wrt)
81    
82        CALL histdef(fileid, 'aire', 'Grid area', '-', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
83             'once', t_ops, t_wrt)
84    
85        CALL histdef(fileid, 'dtime', 'tps phys ', 's', 1, 1, nhoriid, 1, 1, 1, -99, &
86             'once', t_ops, t_wrt)
87    
88        CALL histdef(fileid, 'istphy', 'tps stock', 's', 1, 1, nhoriid, 1, 1, 1, -99, &
89             'once', t_ops, t_wrt)
90    
91        ! T
92    
93        CALL histdef(fileid, 't', 'Temperature', 'K', iim, jjm+1, nhoriid, llm, 1, llm, &
94             zvertiid, 'inst(X)', t_ops, t_wrt)
95    
96        CALL histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s', iim, jjm+1, nhoriid, &
97             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
98    
99        CALL histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s', iim, jjm+1, nhoriid, &
100             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
101    
102        ! en_u
103    
104        CALL histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', iim, jjm+1, nhoriid, &
105             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
106    
107        CALL histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s', iim, jjm+1, nhoriid, &
108             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
109    
110        ! en_d
111    
112        CALL histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', iim, jjm+1, nhoriid, &
113             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
114    
115        ! de_d
116    
117        CALL histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', iim, jjm+1, nhoriid, &
118             llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
119    
120        ! coefh frac_impa, frac_nucl
121    
122        CALL histdef(fileid, 'coefh', ' ', ' ', iim, jjm+1, nhoriid, llm, 1, llm, &
123             zvertiid, 'inst(X)', t_ops, t_wrt)
124    
125        ! abderrahmane le 16 09 02
126        CALL histdef(fileid, 'fm_th', ' ', ' ', iim, jjm+1, nhoriid, llm, 1, llm, &
127             zvertiid, 'inst(X)', t_ops, t_wrt)
128    
129        CALL histdef(fileid, 'en_th', ' ', ' ', iim, jjm+1, nhoriid, llm, 1, llm, &
130             zvertiid, 'inst(X)', t_ops, t_wrt)
131        ! fin aj
132    
133        CALL histdef(fileid, 'frac_impa', ' ', ' ', iim, jjm+1, nhoriid, llm, 1, llm, &
134             zvertiid, 'inst(X)', t_ops, t_wrt)
135    
136        CALL histdef(fileid, 'frac_nucl', ' ', ' ', iim, jjm+1, nhoriid, llm, 1, llm, &
137             zvertiid, 'inst(X)', t_ops, t_wrt)
138    
139        ! pyu1
140    
141        CALL histdef(fileid, 'pyu1', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
142             'inst(X)', t_ops, t_wrt)
143    
144        ! pyv1
145    
146        CALL histdef(fileid, 'pyv1', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
147             'inst(X)', t_ops, t_wrt)
148    
149        CALL histdef(fileid, 'ftsol1', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
150             'inst(X)', t_ops, t_wrt)
151    
152        ! ftsol2
153    
154        CALL histdef(fileid, 'ftsol2', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
155             'inst(X)', t_ops, t_wrt)
156    
157        ! ftsol3
158    
159        CALL histdef(fileid, 'ftsol3', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
160             'inst(X)', t_ops, t_wrt)
161    
162        ! ftsol4
163    
164        CALL histdef(fileid, 'ftsol4', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
165             'inst(X)', t_ops, t_wrt)
166    
167        ! rain
168    
169        CALL histdef(fileid, 'rain', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
170             'inst(X)', t_ops, t_wrt)
171    
172        ! psrf1
173    
174        CALL histdef(fileid, 'psrf1', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
175             'inst(X)', t_ops, t_wrt)
176    
177        ! psrf2
178    
179        CALL histdef(fileid, 'psrf2', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
180             'inst(X)', t_ops, t_wrt)
181    
182        ! psrf3
183    
184        CALL histdef(fileid, 'psrf3', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
185             'inst(X)', t_ops, t_wrt)
186    
187        ! psrf4
188    
189        CALL histdef(fileid, 'psrf4', ' ', ' ', iim, jjm+1, nhoriid, 1, 1, 1, -99, &
190             'inst(X)', t_ops, t_wrt)
191    
192        CALL histend(fileid)
193        IF (ok_sync) CALL histsync
194    
195      END SUBROUTINE initphysto
196    
197    end module initphysto_m
Legend:
Removed from v.12  
changed lines
  Added in v.190
  ViewVC Help
Powered by ViewVC 1.1.21