/[lmdze]/trunk/bibio/initfluxsto.f
ViewVC logotype

Diff of /trunk/bibio/initfluxsto.f

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

trunk/libf/bibio/initfluxsto.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/libf/bibio/initfluxsto.f90 revision 67 by guez, Tue Oct 2 15:50:56 2012 UTC
# Line 1  Line 1 
1  !  SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, nq, fileid, filevid, filedid)
2  ! $Header: /home/cvsroot/LMDZ4/libf/bibio/initfluxsto.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
3  !    ! From bibio/initfluxsto.F, v 1.1.1.1 2004/05/19 12:53:05
4        subroutine initfluxsto  
5       .  (infile,tstep,t_ops,t_wrt,nq,    !   Routine d'initialisation des ecritures des fichiers histoires LMDZ  
6       .                    fileid,filevid,filedid)    !   au format IOIPSL                                                    
7      !   Appels succesifs des routines: histbeg                              
8         USE IOIPSL    !                                  histhori                            
9         USE histcom    !                                  histver                              
10      !                                  histdef                              
11      !                                  histend                              
12  C  
13  C   Routine d'initialisation des ecritures des fichiers histoires LMDZ    !   Entree:                                                            
14  C   au format IOIPSL    !      day0, anne0: date de reference                                    
15  C    !      tstep: duree du pas de temps en seconde                          
16  C   Appels succesifs des routines: histbeg    !      t_ops: frequence de l'operation pour IOIPSL                      
17  C                                  histhori    !      t_wrt: frequence d'ecriture sur le fichier                      
18  C                                  histver    !      nq: nombre de traceurs                                          
19  C                                  histdef  
20  C                                  histend    !   Sortie:                                                            
21  C    !      fileid: ID du fichier netcdf cree                                
22  C   Entree:    !      filevid:ID du fichier netcdf pour la grille v                    
23  C  
24  C      infile: nom du fichier histoire a creer    !   L. Fairhead, 03/99                                            
25  C      day0,anne0: date de reference  
26  C      tstep: duree du pas de temps en seconde    USE calendar
27  C      t_ops: frequence de l'operation pour IOIPSL    USE histbeg_totreg_m, ONLY : histbeg_totreg
28  C      t_wrt: frequence d'ecriture sur le fichier    USE histdef_m, ONLY : histdef
29  C      nq: nombre de traceurs    USE histend_m, ONLY : histend
30  C    use histhori_regular_m, only: histhori_regular
31  C   Sortie:    use histsync_m, only: histsync
32  C      fileid: ID du fichier netcdf cree    USE histvert_m, ONLY : histvert
33  C      filevid:ID du fichier netcdf pour la grille v    USE dimens_m
34  C    USE paramet_m
35  C   L. Fairhead, LMD, 03/99    USE comconst
36  C    USE disvert_m
37  C =====================================================================    use conf_gcm_m
38  C    USE comgeom
39  C   Declarations    USE serre
40         use dimens_m    USE temps, ONLY : annee_ref, day_ref, itau_dyn
41        use paramet_m    USE ener
42        use comconst    USE nr_util, ONLY : pi
43        use comvert  
44        use logic    IMPLICIT NONE
45        use comgeom  
46        use serre    !   Arguments                                                          
47        use temps, only: annee_ref, day_ref, itau_dyn    INTEGER itau
48        use ener    REAL, INTENT (IN) :: tstep
49        implicit none    REAL t_ops, t_wrt
50      INTEGER fileid, filevid, filedid
51  C   Arguments    INTEGER nq, ndex(1)
52  C    REAL nivd(1)
53        character*(*) infile  
54        integer*4 itau    !   Variables locales                                                  
55        real tstep, t_ops, t_wrt    REAL zjulian
56        integer fileid, filevid,filedid    CHARACTER*3 str
57        integer nq,ndex(1)    CHARACTER*10 ctrac
58        real nivd(1)    INTEGER iq
59      REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
60  C   Variables locales    INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
61  C    INTEGER ii, jj
62        integer tau0    INTEGER zan, idayref
63        real zjulian    LOGICAL ok_sync
64        character*3 str  
65        character*10 ctrac    !---------------------------------------------------------
66        integer iq  
67        real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)    !  Initialisations                                                      
68        integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid    str = 'q  '
69        integer ii,jj    ctrac = 'traceur   '
70        integer zan, idayref    ok_sync = .TRUE.
71        logical ok_sync  
72  C    !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
73  C  Initialisations  
74  C    zan = annee_ref
75        pi = 4. * atan (1.)    idayref = day_ref
76        str='q  '    CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
77        ctrac = 'traceur   '  
78        ok_sync = .true.    DO jj = 1, jjp1
79  C       DO ii = 1, iip1
80  C  Appel a histbeg: creation du fichier netcdf et initialisations diverses          rlong(ii, jj) = rlonu(ii)*180./pi
81  C                  rlat(ii, jj) = rlatu(jj)*180./pi
82         END DO
83        zan = annee_ref    END DO
84        idayref = day_ref  
85        CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)    CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
86        tau0 = itau_dyn         itau_dyn, zjulian, tstep, uhoriid, fileid)
87            
88          do jj = 1, jjp1    !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
89          do ii = 1, iip1    !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
90            rlong(ii,jj) = rlonu(ii) * 180. / pi    !  un meme fichier)                                                    
91            rlat(ii,jj) = rlatu(jj) * 180. / pi  
92          enddo    DO jj = 1, jjm
93        enddo       DO ii = 1, iip1
94            rlong(ii, jj) = rlonv(ii)*180./pi
95        call histbeg_totreg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),          rlat(ii, jj) = rlatv(jj)*180./pi
96       .             1, iip1, 1, jjp1,       END DO
97       .             tau0, zjulian, tstep, uhoriid, fileid)    END DO
98  C  
99  C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,    CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
100  C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans         1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
101  C  un meme fichier)  
102      CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
103           zjulian, tstep, dhoriid, filedid)
104        do jj = 1, jjm  
105          do ii = 1, iip1    !  Appel a histhori pour rajouter les autres grilles horizontales      
106            rlong(ii,jj) = rlonv(ii) * 180. / pi  
107            rlat(ii,jj) = rlatv(jj) * 180. / pi    DO jj = 1, jjp1
108          enddo       DO ii = 1, iip1
109        enddo          rlong(ii, jj) = rlonv(ii)*180./pi
110            rlat(ii, jj) = rlatu(jj)*180./pi
111        call histbeg_totreg('fluxstokev.nc', iip1, rlong(:,1), jjm,       END DO
112       .             rlat(1,:),1, iip1, 1, jjm,    END DO
113       .             tau0, zjulian, tstep, vhoriid, filevid)  
114              CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
115          rl(1,1) = 1.             'Grille points scalaires', thoriid)
116        call histbeg_regular('defstoke.nc', 1, rl, 1, rl,  
117       .             1, 1, 1, 1,    !  Appel a histvert pour la grille verticale                            
118       .             tau0, zjulian, tstep, dhoriid, filedid)  
119      CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
120  C         zvertiid)
121  C  Appel a histhori pour rajouter les autres grilles horizontales    ! Pour le fichier V                                                    
122  C    CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivsigs, &
123        do jj = 1, jjp1         zvertiid)
124          do ii = 1, iip1    ! pour le fichier def                                                  
125            rlong(ii,jj) = rlonv(ii) * 180. / pi    nivd(1) = 1
126            rlat(ii,jj) = rlatu(jj) * 180. / pi    CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', nivd, &
127          enddo         dvertiid)
128        enddo  
129      !  Appels a histdef pour la definition des variables a sauvegarder      
130        call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',    CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
131       .              'Grille points scalaires', thoriid)         thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
132              CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
133  C         1, -99, 'once', t_ops, t_wrt)
134  C  Appel a histvert pour la grille verticale    CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
135  C         'once', t_ops, t_wrt)
136        call histvert(fileid, 'sig_s', 'Niveaux sigma',    CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
137       . 'sigma_level',         -99, 'once', t_ops, t_wrt)
138       .              llm, nivsigs, zvertiid)    CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
139  C Pour le fichier V         1, -99, 'once', t_ops, t_wrt)
140        call histvert(filevid, 'sig_s', 'Niveaux sigma',    CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
141       .  'sigma_level',         llm, zvertiid, 'inst(X)', t_ops, t_wrt)
142       .              llm, nivsigs, zvertiid)    CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
143  c pour le fichier def         uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
144        nivd(1) = 1    CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
145        call histvert(filedid, 'sig_s', 'Niveaux sigma',         vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
146       .  'sigma_level',    CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
147       .              1, nivd, dvertiid)         thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
148      CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
149  C         thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
150  C  Appels a histdef pour la definition des variables a sauvegarder    CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
151                   thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
152          CALL histdef(fileid, "phis", "Surface geop. height", "-",  
153       .                iip1,jjp1,thoriid, 1,1,1, -99, 32,    CALL histend(fileid)
154       .                "once", t_ops, t_wrt)    CALL histend(filevid)
155      CALL histend(filedid)
156           CALL histdef(fileid, "aire", "Grid area", "-",    IF (ok_sync) THEN
157       .                iip1,jjp1,thoriid, 1,1,1, -99, 32,       CALL histsync(fileid)
158       .                "once", t_ops, t_wrt)       CALL histsync(filevid)
159                 CALL histsync(filedid)
160          CALL histdef(filedid, "dtvr", "tps dyn", "s",    END IF
161       .                1,1,dhoriid, 1,1,1, -99, 32,  
162       .                "once", t_ops, t_wrt)  END SUBROUTINE initfluxsto
           
          CALL histdef(filedid, "istdyn", "tps stock", "s",  
      .                1,1,dhoriid, 1,1,1, -99, 32,  
      .                "once", t_ops, t_wrt)  
           
          CALL histdef(filedid, "istphy", "tps stock phy", "s",  
      .                1,1,dhoriid, 1,1,1, -99, 32,  
      .                "once", t_ops, t_wrt)  
   
   
 C  
 C Masse  
 C  
       call histdef(fileid, 'masse', 'Masse', 'kg',  
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
 C  
 C  Pbaru  
 C  
       call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',  
      .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
   
 C  
 C  Pbarv  
 C  
       call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',  
      .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
 C  
 C  w  
 C  
       call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',  
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
   
 C  
 C  Temperature potentielle  
 C  
       call histdef(fileid, 'teta', 'temperature potentielle', '-',  
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
 C  
   
 C  
 C Geopotentiel  
 C  
       call histdef(fileid, 'phi', 'geopotentiel instantane', '-',  
      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,  
      .             32, 'inst(X)', t_ops, t_wrt)  
 C  
 C  Fin  
 C  
       call histend(fileid)  
       call histend(filevid)  
       call histend(filedid)  
       if (ok_sync) then  
         call histsync(fileid)  
         call histsync(filevid)  
         call histsync(filedid)  
       endif  
           
       return  
       end  

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

  ViewVC Help
Powered by ViewVC 1.1.21