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

Diff of /trunk/phylmd/initphysto.f

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

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

Legend:
Removed from v.3  
changed lines
  Added in v.61

  ViewVC Help
Powered by ViewVC 1.1.21