/[lmdze]/trunk/Sources/dyn3d/initfluxsto.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/initfluxsto.f

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

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

  ViewVC Help
Powered by ViewVC 1.1.21