[1632] | 1 | ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ |
---|
[5099] | 2 | |
---|
[5114] | 3 | SUBROUTINE writedynav_loc(time, vcov, ucov, teta, ppk, phi, q, & |
---|
| 4 | masse, ps, phis) |
---|
[1632] | 5 | |
---|
[5105] | 6 | ! This routine needs IOIPSL |
---|
| 7 | USE ioipsl |
---|
| 8 | USE parallel_lmdz |
---|
| 9 | USE misc_mod |
---|
| 10 | USE infotrac, ONLY: nqtot |
---|
[5117] | 11 | USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid |
---|
[5105] | 12 | USE comconst_mod, ONLY: cpp |
---|
| 13 | USE temps_mod, ONLY: itau_dyn |
---|
[5114] | 14 | USE lmdz_description, ONLY: descript |
---|
[5118] | 15 | USE lmdz_iniprint, ONLY: lunout, prt_level |
---|
[5136] | 16 | USE lmdz_comgeom |
---|
[1632] | 17 | |
---|
[5159] | 18 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
---|
| 19 | USE lmdz_paramet |
---|
[5113] | 20 | IMPLICIT NONE |
---|
[1632] | 21 | |
---|
[5159] | 22 | |
---|
[5105] | 23 | ! Ecriture du fichier histoire au format IOIPSL |
---|
[5159] | 24 | |
---|
[5105] | 25 | ! Appels succesifs des routines: histwrite |
---|
[5159] | 26 | |
---|
[5105] | 27 | ! Entree: |
---|
| 28 | ! histid: ID du fichier histoire |
---|
| 29 | ! time: temps de l'ecriture |
---|
| 30 | ! vcov: vents v covariants |
---|
| 31 | ! ucov: vents u covariants |
---|
| 32 | ! teta: temperature potentielle |
---|
| 33 | ! phi : geopotentiel instantane |
---|
| 34 | ! q : traceurs |
---|
| 35 | ! masse: masse |
---|
| 36 | ! ps :pression au sol |
---|
| 37 | ! phis : geopotentiel au sol |
---|
[5159] | 38 | |
---|
| 39 | |
---|
[5105] | 40 | ! Sortie: |
---|
| 41 | ! fileid: ID du fichier netcdf cree |
---|
[5159] | 42 | |
---|
[5105] | 43 | ! L. Fairhead, LMD, 03/99 |
---|
[5159] | 44 | |
---|
[5105] | 45 | ! ===================================================================== |
---|
[5159] | 46 | |
---|
[5105] | 47 | ! Declarations |
---|
[1632] | 48 | |
---|
[5159] | 49 | |
---|
| 50 | |
---|
| 51 | |
---|
[5105] | 52 | ! Arguments |
---|
| 53 | ! |
---|
[1632] | 54 | |
---|
[5114] | 55 | REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm) |
---|
| 56 | REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm) |
---|
| 57 | REAL :: ppk(ijb_u:ije_u, llm) |
---|
| 58 | REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm) |
---|
[5105] | 59 | REAL :: phis(ijb_u:ije_u) |
---|
[5114] | 60 | REAL :: q(ijb_u:ije_u, llm, nqtot) |
---|
[5116] | 61 | INTEGER :: time |
---|
[1632] | 62 | |
---|
[5105] | 63 | |
---|
| 64 | ! This routine needs IOIPSL |
---|
| 65 | ! Variables locales |
---|
[5159] | 66 | |
---|
[5114] | 67 | INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:) |
---|
[5105] | 68 | INTEGER :: iq, ii, ll |
---|
[5114] | 69 | REAL, SAVE, ALLOCATABLE :: tm(:, :) |
---|
| 70 | REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :) |
---|
[5117] | 71 | LOGICAL :: ok_sync |
---|
[5116] | 72 | INTEGER :: itau_w |
---|
| 73 | INTEGER :: ijb, ije, jjn |
---|
[5114] | 74 | LOGICAL, SAVE :: first = .TRUE. |
---|
| 75 | !$OMP THREADPRIVATE(first) |
---|
[1632] | 76 | |
---|
[5159] | 77 | |
---|
[5105] | 78 | ! Initialisations |
---|
[5159] | 79 | |
---|
[5117] | 80 | IF (adjust) return |
---|
[5103] | 81 | |
---|
[5105] | 82 | IF (first) THEN |
---|
[5114] | 83 | !$OMP BARRIER |
---|
| 84 | !$OMP MASTER |
---|
| 85 | ALLOCATE(unat(ijb_u:ije_u, llm)) |
---|
| 86 | ALLOCATE(vnat(ijb_v:ije_v, llm)) |
---|
| 87 | ALLOCATE(tm(ijb_u:ije_u, llm)) |
---|
| 88 | ALLOCATE(ndex2d(ijnb_u * llm)) |
---|
| 89 | ALLOCATE(ndexu(ijnb_u * llm)) |
---|
| 90 | ALLOCATE(ndexv(ijnb_v * llm)) |
---|
[5105] | 91 | ndex2d = 0 |
---|
| 92 | ndexu = 0 |
---|
| 93 | ndexv = 0 |
---|
[5114] | 94 | !$OMP END MASTER |
---|
| 95 | !$OMP BARRIER |
---|
| 96 | first = .FALSE. |
---|
[5105] | 97 | ENDIF |
---|
[5103] | 98 | |
---|
[5105] | 99 | ok_sync = .TRUE. |
---|
| 100 | itau_w = itau_dyn + time |
---|
[1632] | 101 | |
---|
[5105] | 102 | ! Passage aux composantes naturelles du vent |
---|
| 103 | CALL covnat_loc(llm, ucov, vcov, unat, vnat) |
---|
[1632] | 104 | |
---|
[5159] | 105 | |
---|
[5105] | 106 | ! Appels a histwrite pour l'ecriture des variables a sauvegarder |
---|
[5159] | 107 | |
---|
[5105] | 108 | ! Vents U |
---|
| 109 | ! |
---|
[1632] | 110 | |
---|
[5114] | 111 | !$OMP BARRIER |
---|
| 112 | !$OMP MASTER |
---|
| 113 | ijb = ij_begin |
---|
| 114 | ije = ij_end |
---|
| 115 | jjn = jj_nb |
---|
[5103] | 116 | |
---|
[5114] | 117 | CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije, :), & |
---|
| 118 | iip1 * jjn * llm, ndexu) |
---|
| 119 | !$OMP END MASTER |
---|
[1632] | 120 | |
---|
[5159] | 121 | |
---|
[5105] | 122 | ! Vents V |
---|
[5159] | 123 | |
---|
[5114] | 124 | ije = ij_end |
---|
[5117] | 125 | IF (pole_sud) jjn = jj_nb - 1 |
---|
| 126 | IF (pole_sud) ije = ij_end - iip1 |
---|
[5114] | 127 | !$OMP BARRIER |
---|
| 128 | !$OMP MASTER |
---|
| 129 | CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije, :), & |
---|
| 130 | iip1 * jjn * llm, ndexv) |
---|
| 131 | !$OMP END MASTER |
---|
[1632] | 132 | |
---|
| 133 | |
---|
[5159] | 134 | |
---|
[5105] | 135 | ! Temperature potentielle moyennee |
---|
[5159] | 136 | |
---|
[5114] | 137 | ijb = ij_begin |
---|
| 138 | ije = ij_end |
---|
| 139 | jjn = jj_nb |
---|
| 140 | !$OMP MASTER |
---|
| 141 | CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije, :), & |
---|
| 142 | iip1 * jjn * llm, ndexu) |
---|
| 143 | !$OMP END MASTER |
---|
[1632] | 144 | |
---|
[5159] | 145 | |
---|
[5105] | 146 | ! Temperature moyennee |
---|
| 147 | ! |
---|
[1632] | 148 | |
---|
[5114] | 149 | !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) |
---|
[5158] | 150 | DO ll = 1, llm |
---|
| 151 | DO ii = ijb, ije |
---|
[5114] | 152 | tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp |
---|
[5105] | 153 | enddo |
---|
| 154 | enddo |
---|
[5114] | 155 | !$OMP ENDDO |
---|
[1632] | 156 | |
---|
[5114] | 157 | !$OMP MASTER |
---|
| 158 | CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije, :), & |
---|
| 159 | iip1 * jjn * llm, ndexu) |
---|
| 160 | !$OMP END MASTER |
---|
[1632] | 161 | |
---|
| 162 | |
---|
[5159] | 163 | |
---|
[5105] | 164 | ! Geopotentiel |
---|
[5159] | 165 | |
---|
[5114] | 166 | !$OMP MASTER |
---|
| 167 | CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), & |
---|
| 168 | iip1 * jjn * llm, ndexu) |
---|
| 169 | !$OMP END MASTER |
---|
[1632] | 170 | |
---|
| 171 | |
---|
[5159] | 172 | |
---|
[5105] | 173 | ! Traceurs |
---|
[5159] | 174 | |
---|
[5105] | 175 | !!$OMP MASTER |
---|
| 176 | ! DO iq=1,nqtot |
---|
| 177 | ! CALL histwrite(histaveid, tracers(iq)%longName, itau_w, & |
---|
| 178 | ! . q(ijb:ije,:,iq), iip1*jjn*llm, ndexu) |
---|
| 179 | ! enddo |
---|
| 180 | !!$OMP END MASTER |
---|
[1632] | 181 | |
---|
| 182 | |
---|
[5159] | 183 | |
---|
[5105] | 184 | ! Masse |
---|
[5159] | 185 | |
---|
[5114] | 186 | !$OMP MASTER |
---|
| 187 | CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije, :), & |
---|
| 188 | iip1 * jjn * llm, ndexu) |
---|
| 189 | !$OMP END MASTER |
---|
[1632] | 190 | |
---|
| 191 | |
---|
[5159] | 192 | |
---|
[5105] | 193 | ! Pression au sol |
---|
[5159] | 194 | |
---|
[5114] | 195 | !$OMP MASTER |
---|
[1632] | 196 | |
---|
[5114] | 197 | CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), & |
---|
| 198 | iip1 * jjn, ndex2d) |
---|
| 199 | !$OMP END MASTER |
---|
[1632] | 200 | |
---|
[5159] | 201 | |
---|
[5105] | 202 | ! Geopotentiel au sol |
---|
[5159] | 203 | |
---|
[5114] | 204 | !$OMP MASTER |
---|
| 205 | ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije), |
---|
[5105] | 206 | ! . iip1*jjn, ndex2d) |
---|
[5114] | 207 | !$OMP END MASTER |
---|
[1632] | 208 | |
---|
[5159] | 209 | |
---|
[5105] | 210 | ! Fin |
---|
[5159] | 211 | |
---|
[5114] | 212 | !$OMP MASTER |
---|
[5117] | 213 | IF (ok_sync) THEN |
---|
[5114] | 214 | CALL histsync(histaveid) |
---|
| 215 | CALL histsync(histvaveid) |
---|
| 216 | CALL histsync(histuaveid) |
---|
[5105] | 217 | ENDIF |
---|
[5114] | 218 | !$OMP END MASTER |
---|
[5116] | 219 | END SUBROUTINE writedynav_loc |
---|