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