- Timestamp:
- Jul 23, 2024, 7:14:34 PM (4 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90
r5104 r5105 2 2 ! $Id$ 3 3 4 SUBROUTINE initfluxsto_p 5 . (infile,tstep,t_ops,t_wrt,6 .fileid,filevid,filedid)7 8 ! This routine needs IOIPSL9 10 11 12 13 14 15 16 17 18 19 C 20 CRoutine d'initialisation des ecritures des fichiers histoires LMDZ21 Cau format IOIPSL22 C 23 CAppels succesifs des routines: histbeg24 Chisthori25 Chistver26 Chistdef27 Chistend28 C 29 CEntree:30 C 31 Cinfile: nom du fichier histoire a creer32 Cday0,anne0: date de reference33 Ctstep: duree du pas de temps en seconde34 Ct_ops: frequence de l'operation pour IOIPSL35 Ct_wrt: frequence d'ecriture sur le fichier36 C 37 CSortie:38 Cfileid: ID du fichier netcdf cree39 Cfilevid:ID du fichier netcdf pour la grille v40 C 41 CL. Fairhead, LMD, 03/9942 C 43 C=====================================================================44 C 45 CDeclarations46 47 48 49 50 51 52 CArguments53 C 54 character*(*)infile55 realtstep, t_ops, t_wrt56 integerfileid, filevid,filedid57 58 ! This routine needs IOIPSL59 CVariables locales60 C 61 realnivd(1)62 integertau063 realzjulian64 character*3str65 character*10ctrac66 integeriq67 realrlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)68 integeruhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid69 integerii,jj70 integerzan, idayref71 logicalok_sync72 73 74 ! definition du domaine d'ecriture pour le rebuild75 76 77 78 79 80 81 82 83 84 85 86 87 C 88 CInitialisations89 C 90 91 92 93 94 C 95 CAppel a histbeg: creation du fichier netcdf et initialisations diverses96 C 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,123 .'box',dynu_domain_id)124 125 CALL histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),126 . 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid,127 .fileid,dynu_domain_id)128 C 129 CCreation du fichier histoire pour la grille en V (oblige pour l'instant,130 CIOIPSL ne permet pas de grilles avec des nombres de point differents dans131 Cun meme fichier)132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,156 .'box',dynv_domain_id)157 158 CALL histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje),159 . 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid,160 .filevid,dynv_domain_id)161 162 163 164 165 166 CALL histbeg('defstoke.nc', 1, rl, 1, rl,167 . 1, 1, 1, 1,168 .tau0, zjulian, tstep, dhoriid, filedid)169 170 171 C 172 CAppel a histhori pour rajouter les autres grilles horizontales173 C 174 175 176 177 178 179 180 181 182 183 184 185 CALL histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),186 .'scalar','Grille points scalaires', thoriid)187 188 C 189 CAppel a histvert pour la grille verticale190 C 191 CALL histvert(fileid, 'sig_s', 'Niveaux sigma',192 . 'sigma_level',193 .llm, nivsigs, zvertiid)194 CPour le fichier V195 CALL histvert(filevid, 'sig_s', 'Niveaux sigma',196 . 'sigma_level',197 .llm, nivsigs, zvertiid)198 cpour le fichier def199 200 201 CALL histvert(filedid, 'sig_s', 'Niveaux sigma',202 . 'sigma_level',203 .1, nivd, dvertiid)204 205 C 206 CAppels a histdef pour la definition des variables a sauvegarder207 208 CALL histdef(fileid, "phis", "Surface geop. height", "-",209 . iip1,jjn,thoriid, 1,1,1, -99, 32,210 ."once", t_ops, t_wrt)211 212 CALL histdef(fileid, "aire", "Grid area", "-",213 . iip1,jjn,thoriid, 1,1,1, -99, 32,214 ."once", t_ops, t_wrt)215 216 217 218 CALL histdef(filedid, "dtvr", "tps dyn", "s",219 . 1,1,dhoriid, 1,1,1, -99, 32,220 ."once", t_ops, t_wrt)221 222 CALL histdef(filedid, "istdyn", "tps stock", "s",223 . 1,1,dhoriid, 1,1,1, -99, 32,224 ."once", t_ops, t_wrt)225 226 CALL histdef(filedid, "istphy", "tps stock phy", "s",227 . 1,1,dhoriid, 1,1,1, -99, 32,228 ."once", t_ops, t_wrt)229 230 231 C 232 CMasse233 C 234 CALL histdef(fileid, 'masse', 'Masse', 'kg',235 . iip1, jjn, thoriid, llm, 1, llm, zvertiid,236 .32, 'inst(X)', t_ops, t_wrt)237 C 238 CPbaru239 C 240 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',241 . iip1, jjn, uhoriid, llm, 1, llm, zvertiid,242 .32, 'inst(X)', t_ops, t_wrt)243 244 C 245 CPbarv246 C 247 248 249 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',250 . iip1, jjn, vhoriid, llm, 1, llm, zvertiid,251 .32, 'inst(X)', t_ops, t_wrt)252 C 253 Cw254 C 255 256 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',257 . iip1, jjn, thoriid, llm, 1, llm, zvertiid,258 .32, 'inst(X)', t_ops, t_wrt)259 260 C 261 CTemperature potentielle262 C 263 CALL histdef(fileid, 'teta', 'temperature potentielle', '-',264 . iip1, jjn, thoriid, llm, 1, llm, zvertiid,265 .32, 'inst(X)', t_ops, t_wrt)266 C 267 268 C 269 CGeopotentiel270 C 271 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-',272 . iip1, jjn, thoriid, llm, 1, llm, zvertiid,273 .32, 'inst(X)', t_ops, t_wrt)274 C 275 CFin276 C 277 278 279 280 281 282 283 284 285 286 return 287 end 4 SUBROUTINE initfluxsto_p & 5 (infile,tstep,t_ops,t_wrt, & 6 fileid,filevid,filedid) 7 8 ! This routine needs IOIPSL 9 USE IOIPSL 10 USE parallel_lmdz 11 use Write_field 12 use misc_mod 13 USE comconst_mod, ONLY: pi 14 USE comvert_mod, ONLY: nivsigs 15 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn 16 17 implicit none 18 19 ! 20 ! Routine d'initialisation des ecritures des fichiers histoires LMDZ 21 ! au format IOIPSL 22 ! 23 ! Appels succesifs des routines: histbeg 24 ! histhori 25 ! histver 26 ! histdef 27 ! histend 28 ! 29 ! Entree: 30 ! 31 ! infile: nom du fichier histoire a creer 32 ! day0,anne0: date de reference 33 ! tstep: duree du pas de temps en seconde 34 ! t_ops: frequence de l'operation pour IOIPSL 35 ! t_wrt: frequence d'ecriture sur le fichier 36 ! 37 ! Sortie: 38 ! fileid: ID du fichier netcdf cree 39 ! filevid:ID du fichier netcdf pour la grille v 40 ! 41 ! L. Fairhead, LMD, 03/99 42 ! 43 ! ===================================================================== 44 ! 45 ! Declarations 46 include "dimensions.h" 47 include "paramet.h" 48 include "comgeom.h" 49 include "description.h" 50 include "iniprint.h" 51 52 ! Arguments 53 ! 54 character(len=*) :: infile 55 real :: tstep, t_ops, t_wrt 56 integer :: fileid, filevid,filedid 57 58 ! This routine needs IOIPSL 59 ! Variables locales 60 ! 61 real :: nivd(1) 62 integer :: tau0 63 real :: zjulian 64 character(len=3) :: str 65 character(len=10) :: ctrac 66 integer :: iq 67 real :: rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1) 68 integer :: uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid 69 integer :: ii,jj 70 integer :: zan, idayref 71 logical :: ok_sync 72 integer :: jjb,jje,jjn 73 74 ! definition du domaine d'ecriture pour le rebuild 75 76 INTEGER,DIMENSION(2) :: ddid 77 INTEGER,DIMENSION(2) :: dsg 78 INTEGER,DIMENSION(2) :: dsl 79 INTEGER,DIMENSION(2) :: dpf 80 INTEGER,DIMENSION(2) :: dpl 81 INTEGER,DIMENSION(2) :: dhs 82 INTEGER,DIMENSION(2) :: dhe 83 84 INTEGER :: dynu_domain_id 85 INTEGER :: dynv_domain_id 86 87 ! 88 ! Initialisations 89 ! 90 pi = 4. * atan (1.) 91 str='q ' 92 ctrac = 'traceur ' 93 ok_sync = .TRUE. 94 ! 95 ! Appel a histbeg: creation du fichier netcdf et initialisations diverses 96 ! 97 98 zan = annee_ref 99 idayref = day_ref 100 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian) 101 tau0 = itau_dyn 102 103 do jj = 1, jjp1 104 do ii = 1, iip1 105 rlong(ii,jj) = rlonu(ii) * 180. / pi 106 rlat(ii,jj) = rlatu(jj) * 180. / pi 107 enddo 108 enddo 109 110 jjb=jj_begin 111 jje=jj_end 112 jjn=jj_nb 113 114 ddid=(/ 1,2 /) 115 dsg=(/ iip1,jjp1 /) 116 dsl=(/ iip1,jjn /) 117 dpf=(/ 1,jjb /) 118 dpl=(/ iip1,jje /) 119 dhs=(/ 0,0 /) 120 dhe=(/ 0,0 /) 121 122 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 123 'box',dynu_domain_id) 124 125 CALL histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje), & 126 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, & 127 fileid,dynu_domain_id) 128 ! 129 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant, 130 ! IOIPSL ne permet pas de grilles avec des nombres de point differents dans 131 ! un meme fichier) 132 133 134 do jj = 1, jjm 135 do ii = 1, iip1 136 rlong(ii,jj) = rlonv(ii) * 180. / pi 137 rlat(ii,jj) = rlatv(jj) * 180. / pi 138 enddo 139 enddo 140 141 jjb=jj_begin 142 jje=jj_end 143 jjn=jj_nb 144 if (pole_sud) jje=jj_end-1 145 if (pole_sud) jjn=jj_nb-1 146 147 ddid=(/ 1,2 /) 148 dsg=(/ iip1,jjm /) 149 dsl=(/ iip1,jjn /) 150 dpf=(/ 1,jjb /) 151 dpl=(/ iip1,jje /) 152 dhs=(/ 0,0 /) 153 dhe=(/ 0,0 /) 154 155 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 156 'box',dynv_domain_id) 157 158 CALL histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje), & 159 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid, & 160 filevid,dynv_domain_id) 161 162 rl(1,1) = 1. 163 164 if (mpi_rank==0) then 165 166 CALL histbeg('defstoke.nc', 1, rl, 1, rl, & 167 1, 1, 1, 1, & 168 tau0, zjulian, tstep, dhoriid, filedid) 169 170 endif 171 ! 172 ! Appel a histhori pour rajouter les autres grilles horizontales 173 ! 174 do jj = 1, jjp1 175 do ii = 1, iip1 176 rlong(ii,jj) = rlonv(ii) * 180. / pi 177 rlat(ii,jj) = rlatu(jj) * 180. / pi 178 enddo 179 enddo 180 181 jjb=jj_begin 182 jje=jj_end 183 jjn=jj_nb 184 185 CALL histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje), & 186 'scalar','Grille points scalaires', thoriid) 187 188 ! 189 ! Appel a histvert pour la grille verticale 190 ! 191 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', & 192 'sigma_level', & 193 llm, nivsigs, zvertiid) 194 ! Pour le fichier V 195 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', & 196 'sigma_level', & 197 llm, nivsigs, zvertiid) 198 ! pour le fichier def 199 if (mpi_rank==0) then 200 nivd(1) = 1 201 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', & 202 'sigma_level', & 203 1, nivd, dvertiid) 204 endif 205 ! 206 ! Appels a histdef pour la definition des variables a sauvegarder 207 208 CALL histdef(fileid, "phis", "Surface geop. height", "-", & 209 iip1,jjn,thoriid, 1,1,1, -99, 32, & 210 "once", t_ops, t_wrt) 211 212 CALL histdef(fileid, "aire", "Grid area", "-", & 213 iip1,jjn,thoriid, 1,1,1, -99, 32, & 214 "once", t_ops, t_wrt) 215 216 if (mpi_rank==0) then 217 218 CALL histdef(filedid, "dtvr", "tps dyn", "s", & 219 1,1,dhoriid, 1,1,1, -99, 32, & 220 "once", t_ops, t_wrt) 221 222 CALL histdef(filedid, "istdyn", "tps stock", "s", & 223 1,1,dhoriid, 1,1,1, -99, 32, & 224 "once", t_ops, t_wrt) 225 226 CALL histdef(filedid, "istphy", "tps stock phy", "s", & 227 1,1,dhoriid, 1,1,1, -99, 32, & 228 "once", t_ops, t_wrt) 229 230 endif 231 ! 232 ! Masse 233 ! 234 CALL histdef(fileid, 'masse', 'Masse', 'kg', & 235 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 236 32, 'inst(X)', t_ops, t_wrt) 237 ! 238 ! Pbaru 239 ! 240 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', & 241 iip1, jjn, uhoriid, llm, 1, llm, zvertiid, & 242 32, 'inst(X)', t_ops, t_wrt) 243 244 ! 245 ! Pbarv 246 ! 247 if (pole_sud) jjn=jj_nb-1 248 249 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', & 250 iip1, jjn, vhoriid, llm, 1, llm, zvertiid, & 251 32, 'inst(X)', t_ops, t_wrt) 252 ! 253 ! w 254 ! 255 if (pole_sud) jjn=jj_nb 256 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', & 257 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 258 32, 'inst(X)', t_ops, t_wrt) 259 260 ! 261 ! Temperature potentielle 262 ! 263 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', & 264 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 265 32, 'inst(X)', t_ops, t_wrt) 266 ! 267 268 ! 269 ! Geopotentiel 270 ! 271 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', & 272 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 273 32, 'inst(X)', t_ops, t_wrt) 274 ! 275 ! Fin 276 ! 277 CALL histend(fileid) 278 CALL histend(filevid) 279 if (mpi_rank==0) CALL histend(filedid) 280 if (ok_sync) then 281 CALL histsync(fileid) 282 CALL histsync(filevid) 283 if (mpi_rank==0) CALL histsync(filedid) 284 endif 285 286 287 end subroutine initfluxsto_p
Note: See TracChangeset
for help on using the changeset viewer.
