| 1 | ! |
|---|
| 2 | ! $Header$ |
|---|
| 3 | ! |
|---|
| 4 | MODULE writephys |
|---|
| 5 | |
|---|
| 6 | ! |
|---|
| 7 | ! Wrapper d'IOIPSL pour l'ecriture des sorties de la physique. Un seul appel |
|---|
| 8 | ! par variable devrait (?) suffire pour l'initialisation et l'ecriture |
|---|
| 9 | ! |
|---|
| 10 | ! LF, LMD, 07/2001 |
|---|
| 11 | ! |
|---|
| 12 | ! 2 routines principales: |
|---|
| 13 | ! writephy_ini pour l'initialisation des fichiers (appel histbeg, histvert) |
|---|
| 14 | ! writephy pour l'ecriture des champs (appel histdef, histwrite) |
|---|
| 15 | ! dans le futur: |
|---|
| 16 | ! writephy_def pour definir des profils de variables |
|---|
| 17 | ! |
|---|
| 18 | USE IOIPSL |
|---|
| 19 | |
|---|
| 20 | IMPLICIT none |
|---|
| 21 | |
|---|
| 22 | PRIVATE |
|---|
| 23 | PUBLIC :: writephy_ini, writephy, writephy_def, writephy_sync |
|---|
| 24 | |
|---|
| 25 | ! |
|---|
| 26 | ! variables locales |
|---|
| 27 | ! |
|---|
| 28 | ! nombre de fichiers maximum a ouvrir |
|---|
| 29 | integer, parameter :: nb_files_max = 20 |
|---|
| 30 | ! nombre de variables maximum par fichier |
|---|
| 31 | integer, parameter :: nb_var_max = 500 |
|---|
| 32 | ! nombre maximum de "profils" de variables |
|---|
| 33 | integer, parameter :: nb_prof_max = 10 |
|---|
| 34 | ! structure d'infos sur les fichiers |
|---|
| 35 | type fichier |
|---|
| 36 | character*30 :: file_name |
|---|
| 37 | integer :: nitau |
|---|
| 38 | integer :: file_id |
|---|
| 39 | integer :: isize, jsize, lsize, phy_lon |
|---|
| 40 | integer :: nhori, nvert |
|---|
| 41 | logical :: define |
|---|
| 42 | end type fichier |
|---|
| 43 | type (fichier), dimension(nb_files_max), save :: hist_files |
|---|
| 44 | ! structure de profils de variables |
|---|
| 45 | type profils |
|---|
| 46 | real :: freq_op |
|---|
| 47 | real :: freq_wri |
|---|
| 48 | character*6 :: var_op |
|---|
| 49 | integer :: zsize |
|---|
| 50 | integer :: reg_size |
|---|
| 51 | integer,dimension(:), pointer :: reg_index |
|---|
| 52 | end type profils |
|---|
| 53 | type (profils), dimension(nb_prof_max), save :: var_profs |
|---|
| 54 | |
|---|
| 55 | ! liste des variables par fichier |
|---|
| 56 | character (len=10), save, dimension(nb_var_max,nb_files_max) :: list_var='undefined' |
|---|
| 57 | ! nombre de variables par fichier |
|---|
| 58 | integer, save, dimension(nb_files_max) :: nb_var = 0 |
|---|
| 59 | ! nombre de bits à sauvegarder dans les fichiers |
|---|
| 60 | integer, save :: nbits = 32 |
|---|
| 61 | ! |
|---|
| 62 | ! Quelques initialisations |
|---|
| 63 | ! |
|---|
| 64 | |
|---|
| 65 | CONTAINS |
|---|
| 66 | |
|---|
| 67 | ! |
|---|
| 68 | !########################################################################### |
|---|
| 69 | ! |
|---|
| 70 | SUBROUTINE writephy_ini(nid_file, nom_fichier, klon, iim, jjm, llm, & |
|---|
| 71 | & rlon, rlat, zlev, & |
|---|
| 72 | & date0, dtime) |
|---|
| 73 | ! |
|---|
| 74 | ! Initialisation des fichiers histoire de la physique |
|---|
| 75 | ! Appels a histbeg, histvert |
|---|
| 76 | ! Remplissage des structures d'informations sur les fichiers |
|---|
| 77 | ! |
|---|
| 78 | ! Entree: |
|---|
| 79 | ! nid_file numero/index du fichier a initialiser |
|---|
| 80 | ! nom_fichier nom du fichier |
|---|
| 81 | ! klon taille des champs physiques |
|---|
| 82 | ! iim, jjm, llm taille en i,j,k |
|---|
| 83 | ! rlon, rlat, zlev coordonnees en x, y, z |
|---|
| 84 | ! date0 date debut |
|---|
| 85 | ! dtime pas de temps elementaire de la physique |
|---|
| 86 | ! |
|---|
| 87 | ! Declaration des parametres d'entree |
|---|
| 88 | integer :: nid_file |
|---|
| 89 | character (len=30) :: nom_fichier |
|---|
| 90 | integer :: iim, jjm, llm, klon |
|---|
| 91 | real, dimension(iim) :: rlon |
|---|
| 92 | real, dimension(jjm) :: rlat |
|---|
| 93 | real, dimension(llm) :: zlev |
|---|
| 94 | real :: date0, dtime |
|---|
| 95 | ! |
|---|
| 96 | ! Variables locales |
|---|
| 97 | ! |
|---|
| 98 | integer :: i, file_id, nvert, nhori |
|---|
| 99 | real, dimension(iim, jjm) :: temp_lon, temp_lat |
|---|
| 100 | logical, save :: first_call = .true. |
|---|
| 101 | integer,parameter :: nulou = 6 |
|---|
| 102 | ! |
|---|
| 103 | ! Quelques initialisations |
|---|
| 104 | ! |
|---|
| 105 | if (first_call) then |
|---|
| 106 | hist_files(:)%define = .true. |
|---|
| 107 | var_profs(:)%freq_wri = -999 |
|---|
| 108 | hist_files(:)%nitau = 1 |
|---|
| 109 | first_call= .false. |
|---|
| 110 | endif |
|---|
| 111 | ! |
|---|
| 112 | ! Mise des coordonnees sur une grille 2D |
|---|
| 113 | ! |
|---|
| 114 | call gr_fi_ecrit(1,klon,iim,jjm,rlon,temp_lon) |
|---|
| 115 | do i = 1, iim |
|---|
| 116 | temp_lon(i,1) = rlon(i+1) |
|---|
| 117 | temp_lon(i,jjm) = rlon(i+1) |
|---|
| 118 | enddo |
|---|
| 119 | call gr_fi_ecrit(1,klon,iim,jjm,rlat,temp_lat) |
|---|
| 120 | ! |
|---|
| 121 | ! Initialisation du fichier |
|---|
| 122 | ! |
|---|
| 123 | call histbeg(nom_fichier, iim, temp_lon, jjm, temp_lat, & |
|---|
| 124 | & 1, iim, 1, jjm, 0, date0, dtime, & |
|---|
| 125 | & nhori, file_id) |
|---|
| 126 | call histvert(file_id, "presnivs", "Vertical levels", "mb", & |
|---|
| 127 | & llm, zlev, nvert) |
|---|
| 128 | |
|---|
| 129 | ! |
|---|
| 130 | ! Remplissage des infos |
|---|
| 131 | ! |
|---|
| 132 | hist_files(nid_file)%file_name = nom_fichier |
|---|
| 133 | hist_files(nid_file)%file_id = file_id |
|---|
| 134 | hist_files(nid_file)%isize = iim |
|---|
| 135 | hist_files(nid_file)%jsize = jjm |
|---|
| 136 | hist_files(nid_file)%lsize = llm |
|---|
| 137 | hist_files(nid_file)%phy_lon = klon |
|---|
| 138 | hist_files(nid_file)%nhori = nhori |
|---|
| 139 | hist_files(nid_file)%nvert = nvert |
|---|
| 140 | |
|---|
| 141 | write(nulou,*)'####################################' |
|---|
| 142 | write(nulou,*)' Definition du fichier no ',nid_file |
|---|
| 143 | write(nulou,*)' nom du fichier ',hist_files(nid_file)%file_name |
|---|
| 144 | write(nulou,*)' identifiant ',hist_files(nid_file)%file_id |
|---|
| 145 | write(nulou,*)' taille en i ',hist_files(nid_file)%isize |
|---|
| 146 | write(nulou,*)' taille en j ',hist_files(nid_file)%jsize |
|---|
| 147 | write(nulou,*)' taille en l ',hist_files(nid_file)%lsize |
|---|
| 148 | |
|---|
| 149 | ! |
|---|
| 150 | END SUBROUTINE writephy_ini |
|---|
| 151 | ! |
|---|
| 152 | !########################################################################### |
|---|
| 153 | ! |
|---|
| 154 | SUBROUTINE writephy_def(profil_n, var_op, freq_op, freq_wri, zsize, & |
|---|
| 155 | & reg_size, reg_index) |
|---|
| 156 | ! |
|---|
| 157 | ! Definition de profil type de sortie de variables |
|---|
| 158 | ! (moyenne, instantanee, indexee ...) |
|---|
| 159 | ! |
|---|
| 160 | ! Parametres d'entree |
|---|
| 161 | ! profil_n numero du profil-type |
|---|
| 162 | ! var_op operation a effectuer sur la variable |
|---|
| 163 | ! freq_op frequence de l'operation |
|---|
| 164 | ! freq_wri frequence d'ecriture |
|---|
| 165 | ! zsize variable 2D/3D |
|---|
| 166 | ! reg_size taille de la region a sortir |
|---|
| 167 | ! reg_index indices de la region a sortir |
|---|
| 168 | ! |
|---|
| 169 | integer :: profil_n |
|---|
| 170 | character (len = 6) :: var_op |
|---|
| 171 | real :: freq_op, freq_wri |
|---|
| 172 | integer :: zsize |
|---|
| 173 | integer, optional :: reg_size |
|---|
| 174 | integer, dimension(*), optional :: reg_index |
|---|
| 175 | ! |
|---|
| 176 | ! variables locales |
|---|
| 177 | ! |
|---|
| 178 | character (len = 20) :: modname = 'writephy_def' |
|---|
| 179 | character (len = 80) :: message |
|---|
| 180 | integer :: dummy_size |
|---|
| 181 | integer :: error |
|---|
| 182 | integer,parameter :: nulou = 6 |
|---|
| 183 | ! |
|---|
| 184 | ! Differentes verif |
|---|
| 185 | ! |
|---|
| 186 | if (profil_n > nb_prof_max) then |
|---|
| 187 | message = 'numero de profil de variable > nbre maximal de profil' |
|---|
| 188 | call abort_gcm(modname, message, 1) |
|---|
| 189 | endif |
|---|
| 190 | if (var_profs(profil_n)%freq_wri /= -999) then |
|---|
| 191 | message = 'numero de profil deja attribue' |
|---|
| 192 | call abort_gcm(modname, message, 1) |
|---|
| 193 | endif |
|---|
| 194 | ! |
|---|
| 195 | ! Remplissage structure infos |
|---|
| 196 | ! |
|---|
| 197 | var_profs(profil_n)%var_op = var_op |
|---|
| 198 | var_profs(profil_n)%freq_op = freq_op |
|---|
| 199 | var_profs(profil_n)%freq_wri = freq_wri |
|---|
| 200 | var_profs(profil_n)%zsize = zsize |
|---|
| 201 | ! |
|---|
| 202 | ! test pour region |
|---|
| 203 | ! |
|---|
| 204 | if (present (reg_size)) then |
|---|
| 205 | if ( .not. present (reg_index)) then |
|---|
| 206 | message = 'reg_size defini mais pas de region definie' |
|---|
| 207 | call abort_gcm(modname, message, 1) |
|---|
| 208 | endif |
|---|
| 209 | allocate(var_profs(profil_n)%reg_index(reg_size), stat = error) |
|---|
| 210 | if (error /= 0) then |
|---|
| 211 | message='Pb allocation reg_index' |
|---|
| 212 | call abort_gcm(modname,message,1) |
|---|
| 213 | endif |
|---|
| 214 | var_profs(profil_n)%reg_size = reg_size |
|---|
| 215 | var_profs(profil_n)%reg_index = reg_index(1:reg_size) |
|---|
| 216 | else |
|---|
| 217 | dummy_size = 1 |
|---|
| 218 | allocate(var_profs(profil_n)%reg_index(dummy_size), stat = error) |
|---|
| 219 | if (error /= 0) then |
|---|
| 220 | message='Pb allocation reg_index' |
|---|
| 221 | call abort_gcm(modname,message,1) |
|---|
| 222 | endif |
|---|
| 223 | var_profs(profil_n)%reg_size = dummy_size |
|---|
| 224 | var_profs(profil_n)%reg_index = 0 |
|---|
| 225 | endif |
|---|
| 226 | |
|---|
| 227 | write(nulou,*)' Definition du profil de variable numero ', profil_n |
|---|
| 228 | write(nulou,*)' operation ',var_profs(profil_n)%var_op |
|---|
| 229 | write(nulou,*)' frequence d''operation ',var_profs(profil_n)%freq_op |
|---|
| 230 | write(nulou,*)' frequence d''ecriture ',var_profs(profil_n)%freq_wri |
|---|
| 231 | write(nulou,*)' 2D/3D ',var_profs(profil_n)%zsize |
|---|
| 232 | write(nulou,*)' taille de la region ',var_profs(profil_n)%reg_size |
|---|
| 233 | |
|---|
| 234 | END SUBROUTINE writephy_def |
|---|
| 235 | ! |
|---|
| 236 | !########################################################################### |
|---|
| 237 | ! |
|---|
| 238 | ! A faire: rendre var_title et var_units optionels par lecture d'un tableau |
|---|
| 239 | ! |
|---|
| 240 | ! |
|---|
| 241 | SUBROUTINE writephy(file, iprof, var_name, data, var_title, var_units) |
|---|
| 242 | ! |
|---|
| 243 | ! Definition et ecriture des variables |
|---|
| 244 | ! |
|---|
| 245 | ! file numero du fichier dans lequel ecrire |
|---|
| 246 | ! iprof profil de la variable a ecrire |
|---|
| 247 | ! var_name nom de la variable a ecrire |
|---|
| 248 | ! data les donnees effectives a ecrire |
|---|
| 249 | ! var_title "vrai" nom de la variable, optionel, si non present |
|---|
| 250 | ! interrogation d'un tableau |
|---|
| 251 | ! var_units unite de la variable, optionel, si non present |
|---|
| 252 | ! interrogation d'un tableau |
|---|
| 253 | |
|---|
| 254 | integer :: file, iprof |
|---|
| 255 | character (len=10) :: var_name |
|---|
| 256 | real, dimension(*) :: data |
|---|
| 257 | character (len=40) :: var_title |
|---|
| 258 | character (len=20) :: var_units |
|---|
| 259 | ! |
|---|
| 260 | ! variables locales |
|---|
| 261 | ! |
|---|
| 262 | integer :: i, error |
|---|
| 263 | character (len=6) :: var_op |
|---|
| 264 | real :: freq_op, freq_wri |
|---|
| 265 | integer :: file_id, isize, jsize, lsize, phy_lon, zsize |
|---|
| 266 | integer :: nhori, nvert, klon |
|---|
| 267 | integer :: nitau |
|---|
| 268 | real, dimension(:,:,:), allocatable :: temp_data |
|---|
| 269 | character (len = 20) :: modname = 'writephy' |
|---|
| 270 | character (len = 80) :: message |
|---|
| 271 | ! |
|---|
| 272 | ! Test: toujours en mode definition des variables? |
|---|
| 273 | ! |
|---|
| 274 | if (var_name == list_var(1, file)) then |
|---|
| 275 | hist_files(file)%nitau = hist_files(file)%nitau + 1 |
|---|
| 276 | endif |
|---|
| 277 | if (hist_files(file)%define) then |
|---|
| 278 | if (var_name == list_var(1, file)) then |
|---|
| 279 | ! on a fait le tour des variables |
|---|
| 280 | hist_files(file)%define = .false. |
|---|
| 281 | call histend(hist_files(file)%file_id) |
|---|
| 282 | ! hist_files(file)%nitau = hist_files(file)%nitau + 1 |
|---|
| 283 | else |
|---|
| 284 | ! |
|---|
| 285 | ! pour que l'appel a histdef soit plus lisible, on range tout dans des tampons |
|---|
| 286 | ! |
|---|
| 287 | file_id = hist_files(file)%file_id |
|---|
| 288 | isize = hist_files(file)%isize |
|---|
| 289 | jsize = hist_files(file)%jsize |
|---|
| 290 | nhori = hist_files(file)%nhori |
|---|
| 291 | klon = hist_files(file)%phy_lon |
|---|
| 292 | var_op = var_profs(iprof)%var_op |
|---|
| 293 | freq_op = var_profs(iprof)%freq_op |
|---|
| 294 | freq_wri = var_profs(iprof)%freq_wri |
|---|
| 295 | if (var_profs(iprof)%zsize == 0) then |
|---|
| 296 | lsize = 1 |
|---|
| 297 | nvert = -99 |
|---|
| 298 | else |
|---|
| 299 | lsize = hist_files(file)%lsize |
|---|
| 300 | nvert = hist_files(file)%nvert |
|---|
| 301 | endif |
|---|
| 302 | call histdef(file_id, var_name, var_title, var_units, & |
|---|
| 303 | & isize, jsize, nhori, lsize, 1, lsize, nvert, nbits, & |
|---|
| 304 | & var_op, freq_op, freq_wri) |
|---|
| 305 | nb_var(file) = nb_var(file) + 1 |
|---|
| 306 | list_var(nb_var(file), file) = var_name |
|---|
| 307 | endif |
|---|
| 308 | endif |
|---|
| 309 | ! |
|---|
| 310 | ! On ecrit la variable |
|---|
| 311 | ! |
|---|
| 312 | ! Preparation |
|---|
| 313 | ! |
|---|
| 314 | file_id = hist_files(file)%file_id |
|---|
| 315 | isize = hist_files(file)%isize |
|---|
| 316 | jsize = hist_files(file)%jsize |
|---|
| 317 | nhori = hist_files(file)%nhori |
|---|
| 318 | var_op = var_profs(iprof)%var_op |
|---|
| 319 | freq_op = var_profs(iprof)%freq_op |
|---|
| 320 | freq_wri = var_profs(iprof)%freq_wri |
|---|
| 321 | nitau = hist_files(file)%nitau |
|---|
| 322 | |
|---|
| 323 | if (var_profs(iprof)%zsize == 0) then |
|---|
| 324 | lsize = 1 |
|---|
| 325 | else |
|---|
| 326 | lsize = hist_files(file)%lsize |
|---|
| 327 | endif |
|---|
| 328 | allocate(temp_data(isize,jsize,lsize), stat = error) |
|---|
| 329 | if (error /= 0) then |
|---|
| 330 | message='Pb allocation temp_data' |
|---|
| 331 | call abort_gcm(modname, message, 1) |
|---|
| 332 | endif |
|---|
| 333 | ! |
|---|
| 334 | ! Ecriture |
|---|
| 335 | ! |
|---|
| 336 | call gr_fi_ecrit(lsize, klon, isize, jsize, data, temp_data) |
|---|
| 337 | call histwrite(file_id, var_name,nitau,temp_data, & |
|---|
| 338 | & var_profs(iprof)%reg_size,var_profs(iprof)%reg_index) |
|---|
| 339 | |
|---|
| 340 | return |
|---|
| 341 | ! |
|---|
| 342 | END SUBROUTINE writephy |
|---|
| 343 | ! |
|---|
| 344 | !########################################################################### |
|---|
| 345 | ! |
|---|
| 346 | SUBROUTINE writephy_sync(nid_file) |
|---|
| 347 | ! |
|---|
| 348 | ! Flush des donnees dans le fichier et eventuellement fermeture du |
|---|
| 349 | ! mode 'define' |
|---|
| 350 | ! |
|---|
| 351 | ! Entree: |
|---|
| 352 | ! nid_file numero du fichier a traiter |
|---|
| 353 | ! |
|---|
| 354 | integer :: nid_file |
|---|
| 355 | ! |
|---|
| 356 | if (hist_files(nid_file)%define) then |
|---|
| 357 | call histend(hist_files(nid_file)%file_id) |
|---|
| 358 | hist_files(nid_file)%define = .false. |
|---|
| 359 | endif |
|---|
| 360 | |
|---|
| 361 | call histsync(hist_files(nid_file)%file_id) |
|---|
| 362 | |
|---|
| 363 | return |
|---|
| 364 | |
|---|
| 365 | END SUBROUTINE writephy_sync |
|---|
| 366 | ! |
|---|
| 367 | !########################################################################### |
|---|
| 368 | ! |
|---|
| 369 | END MODULE writephys |
|---|
