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

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

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

trunk/libf/bibio/inithist.f90 revision 18 by guez, Thu Aug 7 12:29:13 2008 UTC trunk/Sources/dyn3d/inithist.f revision 144 by guez, Wed Jun 10 16:46:46 2015 UTC
# Line 1  Line 1 
1  module inithist_m  module inithist_m
2    
   ! This module is clean: no C preprocessor directive, no include line  
   
3    implicit none    implicit none
4    
5  contains  contains
6    
7    subroutine inithist(day0, anne0, tstep, nq, fileid, filevid, infile, t_ops, &    subroutine inithist(tstep, nq, t_ops, t_wrt)
        t_wrt)  
   
     ! From inithist.F,v 1.1.1.1 2004/05/19 12:53:05  
8    
9      !   Routine d'initialisation des ecritures des fichiers histoires LMDZ      ! From inithist.F, version 1.1.1.1 2004/05/19 12:53:05
10      !   au format IOIPSL      ! L. Fairhead, LMD, 03/99
11    
12      !   Appels succesifs des routines: histbeg      ! Routine d'initialisation des écritures des fichiers histoires
13      !                                  histhori      ! LMDZ au format IOIPSL.
     !                                  histver  
     !                                  histdef  
     !                                  histend  
   
     !   Entree:  
     !      infile: nom du fichier histoire a creer  
     !      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, LMD, 03/99  
   
     USE IOIPSL  
     use dimens_m  
     use paramet_m  
     use comconst  
     use comvert  
     use logic  
     use comgeom  
     use serre  
     use temps  
     use ener  
     use iniadvtrac_m  
   
     !   Arguments  
     character(len=*) infile  
     integer day0, anne0  
     real, intent(in):: tstep, t_ops, t_wrt  
     integer fileid, filevid  
     integer nq  
14    
15      !   Variables locales      USE com_io_dyn, ONLY: histid, histuid, histvid
16        USE dimens_m, ONLY: jjm, llm
17        USE disvert_m, ONLY: presnivs
18        use dynetat0_m, only: day_ref, annee_ref, rlatu, rlatv, rlonu, rlonv
19        USE histbeg_totreg_m, ONLY : histbeg_totreg
20        USE histdef_m, ONLY : histdef
21        USE histend_m, ONLY : histend
22        USE histvert_m, ONLY : histvert
23        USE iniadvtrac_m, ONLY: ttext
24        USE nr_util, ONLY: pi
25        USE paramet_m, ONLY: iip1, jjp1
26        USE temps, ONLY: itau_dyn
27        USE ymds2ju_m, ONLY: ymds2ju
28    
29        real, intent(in):: tstep ! durée du pas de temps en secondes
30        integer, intent(in):: nq ! nombre de traceurs
31        real, intent(in):: t_ops ! fréquence de l'opération pour IOIPSL
32        real, intent(in):: t_wrt ! fréquence d'écriture sur le fichier
33    
34      integer tau0      ! Variables locales:
35      real zjulian      real zjulian
36      integer iq      integer iq
37      real rlong(iip1,jjp1), rlat(iip1,jjp1)      real rlong(iip1, jjp1), rlat(iip1, jjp1)
38      integer uhoriid, vhoriid, thoriid, zvertiid      integer uhoriid, vhoriid, thoriid, zvertiid
39      integer ii,jj      integer ii, jj
     integer zan, dayref  
40    
41      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
42    
43      !  Initialisations      CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
   
     pi = 4. * atan (1.)  
   
     !  Appel a histbeg: creation du fichier netcdf et initialisations diverses  
   
     zan = anne0  
     dayref = day0  
     CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)  
     tau0 = itau_dyn  
44    
45      do jj = 1, jjp1      do jj = 1, jjp1
46         do ii = 1, iip1         do ii = 1, iip1
47            rlong(ii,jj) = rlonu(ii) * 180. / pi            rlong(ii, jj) = rlonu(ii) * 180. / pi
48            rlat(ii,jj) = rlatu(jj) * 180. / pi            rlat(ii, jj) = rlatu(jj) * 180. / pi
49         enddo         enddo
50      enddo      enddo
51    
52      call histbeg_totreg(infile, rlong(:,1), rlat(1,:), &      call histbeg_totreg("dyn_histu.nc", rlong(:,1), rlat(1,:), 1, iip1, 1, &
53           1, iip1, 1, jjp1, &           jjp1, itau_dyn, zjulian, tstep, uhoriid, histuid)
          tau0, 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)  
54    
55      do jj = 1, jjm      do jj = 1, jjm
56         do ii = 1, iip1         do ii = 1, iip1
57            rlong(ii,jj) = rlonv(ii) * 180. / pi            rlong(ii, jj) = rlonv(ii) * 180. / pi
58            rlat(ii,jj) = rlatv(jj) * 180. / pi            rlat(ii, jj) = rlatv(jj) * 180. / pi
59         enddo         enddo
60      enddo      enddo
61    
62      call histbeg_totreg('dyn_histv.nc', rlong(:,1), rlat(1,:jjm), &      ! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
63           1, iip1, 1, jjm, &      ! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
64           tau0, zjulian, tstep, vhoriid, filevid)      ! un meme fichier)
65      !  
66      !  Appel a histhori pour rajouter les autres grilles horizontales      call histbeg_totreg('dyn_histv.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
67      !           1, jjm, itau_dyn, zjulian, tstep, vhoriid, histvid)
68    
69      do jj = 1, jjp1      do jj = 1, jjp1
70         do ii = 1, iip1         do ii = 1, iip1
71            rlong(ii,jj) = rlonv(ii) * 180. / pi            rlong(ii, jj) = rlonv(ii) * 180. / pi
72            rlat(ii,jj) = rlatu(jj) * 180. / pi            rlat(ii, jj) = rlatu(jj) * 180. / pi
73         enddo         enddo
74      enddo      enddo
75    
76      call histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &      call histbeg_totreg("dyn_hist.nc", rlong(:, 1), rlat(1, :), 1, iip1, 1, &
77           'Grille points scalaires', thoriid)           jjp1, itau_dyn, zjulian, tstep, thoriid, histid)
78      !  
79      !  Appel a histvert pour la grille verticale      ! Appel a histvert pour la grille verticale
80      !  
81      call histvert(fileid, 'sig_s', 'Niveaux sigma','-', &      call histvert(histid, 'presnivs', 'Niveaux pression','mb', presnivs/100., &
82           llm, nivsigs, zvertiid)           zvertiid,'down')
83      ! Pour le fichier V      call histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
84      call histvert(filevid, 'sig_s', 'Niveaux sigma','-', &           presnivs/100., zvertiid,'down')
85           llm, nivsigs, zvertiid)      call histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
86      !           presnivs/100., zvertiid,'down')
87      !  Appels a histdef pour la definition des variables a sauvegarder  
88      !      ! Appels a histdef pour la definition des variables a sauvegarder
89      !  Vents U  
90      !      call histdef(histuid, 'u', 'vent u', 'm/s', iip1, jjp1, uhoriid, llm, 1, &
91      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s', &           llm, zvertiid, 'inst(X)', t_ops, t_wrt)
92           iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &      call histdef(histvid, 'v', 'vent v', 'm/s', iip1, jjm, vhoriid, llm, 1, &
93           'inst(X)', t_ops, t_wrt)           llm, zvertiid, 'inst(X)', t_ops, t_wrt)
94      !      call histdef(histid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
95      !  Vents V           thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
96      !      call histdef(histid, 'phi', 'geopotentiel', '-', iip1, jjp1, thoriid, &
97      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s', &           llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
98           iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &  
99           'inst(X)', t_ops, t_wrt)      ! Traceurs
100        DO iq=1, nq
101      !         call histdef(histid, ttext(iq), ttext(iq), '-', iip1, jjp1, thoriid, &
102      !  Temperature potentielle              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)  
     !  
     !  Geopotentiel  
     !  
     call histdef(fileid, 'phi', 'geopotentiel instantane', '-', &  
          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &  
          'inst(X)', t_ops, t_wrt)  
     !  
     !  Traceurs  
     !  
     DO iq=1,nq  
        call histdef(fileid, ttext(iq),  ttext(iq), '-', &  
             iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &  
             'inst(X)', t_ops, t_wrt)  
103      enddo      enddo
104      !  
105      !  Masse      call histdef(histid, 'masse', 'masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
106      !           llm, zvertiid, 'inst(X)', t_ops, t_wrt)
107      call histdef(fileid, 'masse', 'masse', 'kg', &      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', iip1, jjp1, &
108           iip1, jjp1, thoriid, 1, 1, 1, -99, &           thoriid, 1, 1, 1, -99, 'inst(X)', t_ops, t_wrt)
109           'inst(X)', t_ops, t_wrt)      call histdef(histid, 'phis', 'geopotentiel au sol', '-', iip1, jjp1, &
110      !           thoriid, 1, 1, 1, -99, 'inst(X)', t_ops, t_wrt)
111      !  Pression au sol  
112      !      call histend(histid)
113      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa', &      call histend(histuid)
114           iip1, jjp1, thoriid, 1, 1, 1, -99, &      call histend(histvid)
          'inst(X)', t_ops, t_wrt)  
     !  
     !  Pression au sol  
     !  
     call histdef(fileid, 'phis', 'geopotentiel au sol', '-', &  
          iip1, jjp1, thoriid, 1, 1, 1, -99, &  
          'inst(X)', t_ops, t_wrt)  
     !  
     !  Fin  
     !  
     call histend(fileid)  
     call histend(filevid)  
115    
116    end subroutine inithist    end subroutine inithist
117    
Legend:
Removed from v.18  
changed lines
  Added in v.144
  ViewVC Help
Powered by ViewVC 1.1.21