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

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

  ViewVC Help
Powered by ViewVC 1.1.21