Changeset 272 for LMDZ.3.3/branches/rel-LF/libf

Timestamp:

Sep 5, 2001, 6:11:26 PM (23 years ago)

Author:

lmdzadmin

Message:

Rajout de profils de variables par fichiers et non plus globaux
Redefinition des chaines de caracteres passees
LF

File:

• LMDZ.3.3/branches/rel-LF/libf/bibio/writephys.F90 (modified) (13 diffs)

LMDZ.3.3/branches/rel-LF/libf/bibio/writephys.F90

@@ -51 +51 @@
      integer,dimension(:), pointer :: reg_index
   end type profils 
-  type (profils), dimension(nb_prof_max), save :: var_profs
+  type (profils), dimension(nb_prof_max, nb_files_max), save :: var_profs
 
 ! liste des variables par fichier
@@ -87 +87 @@
 ! Declaration des parametres d'entree
   integer :: nid_file
-  character (len=30) :: nom_fichier
+  character*(*) :: nom_fichier
   integer :: iim, jjm, llm, klon
   real, dimension(iim) :: rlon
@@ -105 +105 @@
   if (first_call) then
     hist_files(:)%define = .true.
-    var_profs(:)%freq_wri = -999
+    var_profs(:,:)%freq_wri = -999
     hist_files(:)%nitau = 1
     first_call= .false.
@@ -152 +152 @@
 !###########################################################################
 !
-  SUBROUTINE writephy_def(profil_n, var_op, freq_op, freq_wri, zsize, &
+  SUBROUTINE writephy_def(profil_n, nid_file,               &
+ &                        var_op, freq_op, freq_wri, zsize, &
  &                        reg_size, reg_index)
 !
@@ -160 +161 @@
 ! Parametres d'entree
 !   profil_n      numero du profil-type
+!   nid_file      numero de fichier
 !   var_op        operation a effectuer sur la variable 
 !   freq_op       frequence de l'operation
@@ -168 +170 @@
 !
   integer                         :: profil_n
-  character (len = 6)             :: var_op
+  integer                         :: nid_file
+  character*(*)             :: var_op
   real                            :: freq_op, freq_wri
   integer                         :: zsize
@@ -188 +191 @@
     call abort_gcm(modname, message, 1)
   endif
-  if (var_profs(profil_n)%freq_wri /= -999) then
+  if (var_profs(profil_n, nid_file)%freq_wri /= -999) then
     message = 'numero de profil deja attribue'
     call abort_gcm(modname, message, 1)
@@ -195 +198 @@
 ! 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
+  var_profs(profil_n, nid_file)%var_op = var_op
+  var_profs(profil_n, nid_file)%freq_op = freq_op
+  var_profs(profil_n, nid_file)%freq_wri = freq_wri
+  var_profs(profil_n, nid_file)%zsize = zsize
 !
 ! test pour region
@@ -207 +210 @@
       call abort_gcm(modname, message, 1)
     endif
-    allocate(var_profs(profil_n)%reg_index(reg_size), stat = error)
+    allocate(var_profs(profil_n, nid_file)%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)
+    var_profs(profil_n, nid_file)%reg_size = reg_size
+    var_profs(profil_n, nid_file)%reg_index = reg_index(1:reg_size)
   else
     dummy_size = 1
-    allocate(var_profs(profil_n)%reg_index(dummy_size), stat = error)
+    allocate(var_profs(profil_n, nid_file)%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
+    var_profs(profil_n, nid_file)%reg_size = dummy_size
+    var_profs(profil_n, nid_file)%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
+  write(nulou,*)'                              du fichier ', nid_file
+  write(nulou,*)'     operation               ', &
+ &                    var_profs(profil_n, nid_file)%var_op
+  write(nulou,*)'     frequence d''operation  ', &
+ &                    var_profs(profil_n, nid_file)%freq_op
+  write(nulou,*)'     frequence d''ecriture   ', &
+ &                    var_profs(profil_n, nid_file)%freq_wri
+  write(nulou,*)'     2D/3D                   ', &
+ &                    var_profs(profil_n, nid_file)%zsize
+  write(nulou,*)'     taille de la region     ', &
+ &                    var_profs(profil_n, nid_file)%reg_size
 
   END SUBROUTINE writephy_def
@@ -253 +262 @@
 
   integer              :: file, iprof
-  character (len=10)   :: var_name
+  character*(*)        :: var_name
   real, dimension(*)   :: data
-  character (len=40)   :: var_title
-  character (len=20)   :: var_units
+  character*(*)        :: var_title
+  character*(*)        :: var_units
 !
 ! variables locales
 !
   integer              :: i, error
-  character (len=6)   :: var_op
+  character (len=6)    :: var_op
   real                 :: freq_op, freq_wri
   integer              :: file_id, isize, jsize, lsize, phy_lon, zsize
@@ -290 +299 @@
       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
+      var_op = var_profs(iprof, file)%var_op
+      freq_op = var_profs(iprof, file)%freq_op
+      freq_wri = var_profs(iprof, file)%freq_wri
+      if (var_profs(iprof, file)%zsize == 0) then
         lsize = 1
         nvert = -99
@@ -316 +325 @@
   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
+  var_op = var_profs(iprof, file)%var_op
+  freq_op = var_profs(iprof, file)%freq_op
+  freq_wri = var_profs(iprof, file)%freq_wri
   nitau = hist_files(file)%nitau
 
-  if (var_profs(iprof)%zsize == 0) then
+  if (var_profs(iprof, file)%zsize == 0) then
     lsize = 1
   else
@@ -336 +345 @@
   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)
+ &               var_profs(iprof, file)%reg_size, &
+ &               var_profs(iprof, file)%reg_index)
    
   return