/[lmdze]/trunk/libf/bibio/inithist.f90
ViewVC logotype

Diff of /trunk/libf/bibio/inithist.f90

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

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