Index: /LMDZ.3.3/trunk/libf/bibio/writephys.F90
===================================================================
--- /LMDZ.3.3/trunk/libf/bibio/writephys.F90	(revision 264)
+++ /LMDZ.3.3/trunk/libf/bibio/writephys.F90	(revision 264)
@@ -0,0 +1,369 @@
+!
+! $Header$
+!
+  MODULE writephys
+
+!
+! Wrapper d'IOIPSL pour l'ecriture des sorties de la physique. Un seul appel 
+! par variable devrait (?) suffire pour l'initialisation et l'ecriture
+!
+! LF, LMD, 07/2001
+!
+! 2 routines principales:
+!   writephy_ini pour l'initialisation des fichiers (appel histbeg, histvert)
+!   writephy pour l'ecriture des champs (appel histdef, histwrite)
+! dans le futur:
+!   writephy_def pour definir des profils de variables
+! 
+  USE IOIPSL
+
+  IMPLICIT none
+
+  PRIVATE
+  PUBLIC :: writephy_ini, writephy, writephy_def, writephy_sync
+
+!
+! variables locales 
+!
+! nombre de fichiers maximum a ouvrir
+  integer, parameter :: nb_files_max = 20
+! nombre de variables maximum par fichier
+  integer, parameter :: nb_var_max = 500
+! nombre maximum de "profils" de variables
+  integer, parameter :: nb_prof_max = 10
+! structure d'infos sur les fichiers
+  type fichier
+     character*30        :: file_name
+     integer             :: nitau
+     integer             :: file_id
+     integer             :: isize, jsize, lsize, phy_lon
+     integer             :: nhori, nvert
+     logical             :: define
+  end type fichier
+  type (fichier), dimension(nb_files_max), save :: hist_files
+! structure de profils de variables
+  type profils
+     real               :: freq_op
+     real               :: freq_wri
+     character*6        :: var_op
+     integer            :: zsize
+     integer            :: reg_size
+     integer,dimension(:), pointer :: reg_index
+  end type profils 
+  type (profils), dimension(nb_prof_max), save :: var_profs
+
+! liste des variables par fichier
+  character (len=10), save, dimension(nb_var_max,nb_files_max) :: list_var='undefined'
+! nombre de variables par fichier
+  integer, save, dimension(nb_files_max) :: nb_var = 0 
+! nombre de bits à sauvegarder dans les fichiers
+  integer, save :: nbits = 32
+!
+! Quelques initialisations
+!
+
+  CONTAINS
+
+!
+!###########################################################################
+!
+  SUBROUTINE writephy_ini(nid_file, nom_fichier, klon, iim, jjm, llm, &
+ &                        rlon, rlat, zlev, &
+ &                        date0, dtime)
+!
+! Initialisation des fichiers histoire de la physique
+! Appels a histbeg, histvert
+! Remplissage des structures d'informations sur les fichiers
+! 
+! Entree:
+!   nid_file          numero/index du fichier a initialiser
+!   nom_fichier       nom du fichier
+!   klon              taille des champs physiques
+!   iim, jjm, llm     taille en i,j,k      
+!   rlon, rlat, zlev  coordonnees en x, y, z
+!   date0             date debut
+!   dtime             pas de temps elementaire de la physique 
+!   
+! Declaration des parametres d'entree
+  integer :: nid_file
+  character (len=30) :: nom_fichier
+  integer :: iim, jjm, llm, klon
+  real, dimension(iim) :: rlon
+  real, dimension(jjm) :: rlat
+  real, dimension(llm) :: zlev
+  real                 :: date0, dtime
+!
+! Variables locales
+!
+  integer :: i, file_id, nvert, nhori
+  real, dimension(iim, jjm) :: temp_lon, temp_lat
+  logical, save             :: first_call = .true.
+  integer,parameter         :: nulou = 6
+!
+! Quelques initialisations
+!
+  if (first_call) then
+    hist_files(:)%define = .true.
+    var_profs(:)%freq_wri = -999
+    hist_files(:)%nitau = 1
+    first_call= .false.
+  endif
+!
+! Mise des coordonnees sur une grille 2D
+!
+  call gr_fi_ecrit(1,klon,iim,jjm,rlon,temp_lon)
+  do i = 1, iim
+    temp_lon(i,1) = rlon(i+1)
+    temp_lon(i,jjm) = rlon(i+1)
+  enddo
+  call gr_fi_ecrit(1,klon,iim,jjm,rlat,temp_lat)
+!
+! Initialisation du fichier
+!
+  call histbeg(nom_fichier, iim, temp_lon, jjm, temp_lat, &
+     &                 1, iim, 1, jjm, 0, date0, dtime, &
+     &                 nhori, file_id)
+  call histvert(file_id, "presnivs", "Vertical levels", "mb", &
+     &                 llm, zlev, nvert)
+
+!
+! Remplissage des infos
+!
+  hist_files(nid_file)%file_name = nom_fichier
+  hist_files(nid_file)%file_id = file_id
+  hist_files(nid_file)%isize = iim
+  hist_files(nid_file)%jsize = jjm
+  hist_files(nid_file)%lsize = llm
+  hist_files(nid_file)%phy_lon = klon
+  hist_files(nid_file)%nhori = nhori
+  hist_files(nid_file)%nvert = nvert
+
+  write(nulou,*)'####################################'
+  write(nulou,*)' Definition du fichier no ',nid_file
+  write(nulou,*)'    nom du fichier     ',hist_files(nid_file)%file_name
+  write(nulou,*)'    identifiant        ',hist_files(nid_file)%file_id
+  write(nulou,*)'    taille en i        ',hist_files(nid_file)%isize
+  write(nulou,*)'    taille en j        ',hist_files(nid_file)%jsize
+  write(nulou,*)'    taille en l        ',hist_files(nid_file)%lsize
+
+!
+  END SUBROUTINE writephy_ini
+!
+!###########################################################################
+!
+  SUBROUTINE writephy_def(profil_n, var_op, freq_op, freq_wri, zsize, &
+ &                        reg_size, reg_index)
+!
+! Definition de profil type de sortie de variables 
+!               (moyenne, instantanee, indexee ...)
+!
+! Parametres d'entree
+!   profil_n      numero du profil-type
+!   var_op        operation a effectuer sur la variable 
+!   freq_op       frequence de l'operation
+!   freq_wri      frequence d'ecriture
+!   zsize         variable 2D/3D
+!   reg_size      taille de la region a sortir
+!   reg_index     indices de la region a sortir
+!
+  integer                         :: profil_n
+  character (len = 6)             :: var_op
+  real                            :: freq_op, freq_wri
+  integer                         :: zsize
+  integer, optional               :: reg_size
+  integer, dimension(*), optional :: reg_index
+!
+! variables locales
+!
+  character (len = 20) :: modname = 'writephy_def'
+  character (len = 80) :: message
+  integer              :: dummy_size
+  integer              :: error 
+  integer,parameter    :: nulou = 6
+!
+! Differentes verif
+!
+  if (profil_n > nb_prof_max) then
+    message = 'numero de profil de variable > nbre maximal de profil'
+    call abort_gcm(modname, message, 1)
+  endif
+  if (var_profs(profil_n)%freq_wri /= -999) then
+    message = 'numero de profil deja attribue'
+    call abort_gcm(modname, message, 1)
+  endif        
+!
+! Remplissage structure infos
+!
+  var_profs(profil_n)%var_op = var_op
+  var_profs(profil_n)%freq_op = freq_op
+  var_profs(profil_n)%freq_wri = freq_wri
+  var_profs(profil_n)%zsize = zsize
+!
+! test pour region
+!
+  if (present (reg_size)) then
+    if ( .not. present (reg_index)) then
+      message = 'reg_size defini mais pas de region definie'
+      call abort_gcm(modname, message, 1)
+    endif
+    allocate(var_profs(profil_n)%reg_index(reg_size), stat = error)
+    if (error /= 0) then
+      message='Pb allocation reg_index'
+      call abort_gcm(modname,message,1)
+    endif
+    var_profs(profil_n)%reg_size = reg_size
+    var_profs(profil_n)%reg_index = reg_index(1:reg_size)
+  else
+    dummy_size = 1
+    allocate(var_profs(profil_n)%reg_index(dummy_size), stat = error)
+    if (error /= 0) then
+      message='Pb allocation reg_index'
+      call abort_gcm(modname,message,1)
+    endif
+    var_profs(profil_n)%reg_size = dummy_size
+    var_profs(profil_n)%reg_index = 0
+  endif
+
+  write(nulou,*)' Definition du profil de variable numero ', profil_n
+  write(nulou,*)'     operation               ',var_profs(profil_n)%var_op
+  write(nulou,*)'     frequence d''operation  ',var_profs(profil_n)%freq_op
+  write(nulou,*)'     frequence d''ecriture   ',var_profs(profil_n)%freq_wri
+  write(nulou,*)'     2D/3D                   ',var_profs(profil_n)%zsize
+  write(nulou,*)'     taille de la region     ',var_profs(profil_n)%reg_size
+
+  END SUBROUTINE writephy_def
+!
+!###########################################################################
+!
+! A faire: rendre var_title et var_units optionels par lecture d'un tableau
+!
+!
+  SUBROUTINE writephy(file, iprof, var_name, data, var_title, var_units)
+!
+! Definition et ecriture des variables
+!
+! file             numero du fichier dans lequel ecrire
+! iprof            profil de la variable a ecrire
+! var_name         nom de la variable a ecrire
+! data             les donnees effectives a ecrire  
+! var_title        "vrai" nom de la variable, optionel, si non present 
+!                  interrogation d'un tableau
+! var_units        unite de la variable, optionel, si non present 
+!                  interrogation d'un tableau
+
+  integer              :: file, iprof
+  character (len=10)   :: var_name
+  real, dimension(*)   :: data
+  character (len=40)   :: var_title
+  character (len=20)   :: var_units
+!
+! variables locales
+!
+  integer              :: i, error
+  character (len=6)   :: var_op
+  real                 :: freq_op, freq_wri
+  integer              :: file_id, isize, jsize, lsize, phy_lon, zsize
+  integer              :: nhori, nvert, klon
+  integer              :: nitau
+  real, dimension(:,:,:), allocatable :: temp_data
+  character (len = 20) :: modname = 'writephy'
+  character (len = 80) :: message
+!
+! Test: toujours en mode definition des variables?
+!
+  if (var_name == list_var(1, file)) then
+    hist_files(file)%nitau = hist_files(file)%nitau + 1
+  endif
+  if (hist_files(file)%define) then
+    if (var_name == list_var(1, file)) then
+!     on a fait le tour des variables
+      hist_files(file)%define = .false.
+      call histend(hist_files(file)%file_id)
+!      hist_files(file)%nitau = hist_files(file)%nitau + 1
+    else
+!
+! pour que l'appel a histdef soit plus lisible, on range tout dans des tampons
+!
+      file_id = hist_files(file)%file_id
+      isize = hist_files(file)%isize
+      jsize = hist_files(file)%jsize    
+      nhori = hist_files(file)%nhori
+      klon = hist_files(file)%phy_lon
+      var_op = var_profs(iprof)%var_op
+      freq_op = var_profs(iprof)%freq_op
+      freq_wri = var_profs(iprof)%freq_wri
+      if (var_profs(iprof)%zsize == 0) then
+        lsize = 1
+        nvert = -99
+      else
+        lsize = hist_files(file)%lsize
+        nvert = hist_files(file)%nvert
+      endif
+      call histdef(file_id, var_name, var_title, var_units,  &
+ &                isize, jsize, nhori, lsize, 1, lsize, nvert, nbits,  &
+ &                var_op, freq_op, freq_wri)
+      nb_var(file) = nb_var(file) + 1
+      list_var(nb_var(file), file) = var_name
+    endif
+  endif
+!
+! On ecrit la variable
+!
+! Preparation
+!
+  file_id = hist_files(file)%file_id
+  isize = hist_files(file)%isize
+  jsize = hist_files(file)%jsize    
+  nhori = hist_files(file)%nhori
+  var_op = var_profs(iprof)%var_op
+  freq_op = var_profs(iprof)%freq_op
+  freq_wri = var_profs(iprof)%freq_wri
+  nitau = hist_files(file)%nitau
+
+  if (var_profs(iprof)%zsize == 0) then
+    lsize = 1
+  else
+    lsize = hist_files(file)%lsize
+  endif
+  allocate(temp_data(isize,jsize,lsize), stat = error)
+  if (error /= 0) then
+    message='Pb allocation temp_data'
+    call abort_gcm(modname, message, 1)
+  endif
+!
+! Ecriture
+!
+  call gr_fi_ecrit(lsize, klon, isize, jsize, data, temp_data)
+  call histwrite(file_id, var_name,nitau,temp_data, &
+ &               var_profs(iprof)%reg_size,var_profs(iprof)%reg_index)
+   
+  return
+!
+  END SUBROUTINE writephy 
+!
+!###########################################################################
+!
+  SUBROUTINE writephy_sync(nid_file)
+!
+! Flush des donnees dans le fichier et eventuellement fermeture du 
+! mode 'define'
+!
+! Entree:
+!   nid_file    numero du fichier a traiter
+!
+  integer     :: nid_file
+!
+  if (hist_files(nid_file)%define) then
+    call histend(hist_files(nid_file)%file_id)
+    hist_files(nid_file)%define = .false.
+  endif
+
+  call histsync(hist_files(nid_file)%file_id)
+  
+return
+
+  END SUBROUTINE writephy_sync 
+!
+!###########################################################################
+!
+  END MODULE writephys
