Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/writehist_loc.F90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/writehist_loc.F90
r5245 r5246 2 2 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 3 ! 4 subroutine writehist_loc( time, vcov, ucov,teta,ppk,phi,q, 5 .masse,ps,phis)4 subroutine writehist_loc( time, vcov, ucov,teta,ppk,phi,q, & 5 masse,ps,phis) 6 6 7 7 #ifdef CPP_IOIPSL 8 ! This routine needs IOIPSL9 8 ! This routine needs IOIPSL 9 USE ioipsl 10 10 #endif 11 12 13 14 15 16 17 18 19 20 C 21 CEcriture du fichier histoire au format IOIPSL22 C 23 CAppels succesifs des routines: histwrite24 C 25 CEntree:26 Chistid: ID du fichier histoire27 Ctime: temps de l'ecriture28 Cvcov: vents v covariants29 Cucov: vents u covariants30 Cteta: temperature potentielle31 Cphi : geopotentiel instantane32 Cq : traceurs33 Cmasse: masse34 Cps :pression au sol35 Cphis : geopotentiel au sol36 C 37 C 38 CSortie:39 Cfileid: ID du fichier netcdf cree40 C 41 CL. Fairhead, LMD, 03/9942 C 43 C=====================================================================44 C 45 CDeclarations46 47 48 49 50 51 52 C 53 CArguments54 C 55 56 REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)57 REALteta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)58 REAL ppk(ijb_u:ije_u,llm)59 REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)60 REAL phis(ijb_u:ije_u)61 REALq(ijb_u:ije_u,llm,nqtot)62 integertime11 USE parallel_lmdz 12 USE misc_mod 13 USE infotrac, ONLY : nqtot 14 use com_io_dyn_mod, only : histid,histvid,histuid 15 USE comconst_mod, ONLY: cpp 16 USE temps_mod, ONLY: itau_dyn 17 18 implicit none 19 20 ! 21 ! Ecriture du fichier histoire au format IOIPSL 22 ! 23 ! Appels succesifs des routines: histwrite 24 ! 25 ! Entree: 26 ! histid: ID du fichier histoire 27 ! time: temps de l'ecriture 28 ! vcov: vents v covariants 29 ! ucov: vents u covariants 30 ! teta: temperature potentielle 31 ! phi : geopotentiel instantane 32 ! q : traceurs 33 ! masse: masse 34 ! ps :pression au sol 35 ! phis : geopotentiel au sol 36 ! 37 ! 38 ! Sortie: 39 ! fileid: ID du fichier netcdf cree 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 ! 53 ! Arguments 54 ! 55 56 REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm) 57 REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm) 58 REAL :: ppk(ijb_u:ije_u,llm) 59 REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm) 60 REAL :: phis(ijb_u:ije_u) 61 REAL :: q(ijb_u:ije_u,llm,nqtot) 62 integer :: time 63 63 64 64 65 65 #ifdef CPP_IOIPSL 66 ! This routine needs IOIPSL67 CVariables locales68 C 69 70 71 72 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)73 logicalok_sync74 integeritau_w75 76 66 ! This routine needs IOIPSL 67 ! Variables locales 68 ! 69 INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:) 70 INTEGER :: iq, ii, ll 71 REAL,SAVE,ALLOCATABLE :: tm(:,:) 72 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:) 73 logical :: ok_sync 74 integer :: itau_w 75 integer :: ijb,ije,jjn 76 LOGICAL,SAVE :: first=.TRUE. 77 77 !$OMP THREADPRIVATE(first) 78 78 79 C 80 CInitialisations81 C 82 83 84 85 !$OMP BARRIER 86 !$OMP MASTER 87 88 ALLOCATE(vnat(ijb_v:ije_v,llm))89 90 91 92 93 94 95 96 !$OMP END MASTER 97 !$OMP BARRIER 98 99 100 101 102 103 104 CPassage aux composantes naturelles du vent105 106 107 C 108 CAppels a histwrite pour l'ecriture des variables a sauvegarder109 C 110 CVents U111 C 112 113 !$OMP BARRIER 114 !$OMP MASTER 115 116 117 118 119 call histwrite(histuid, 'u', itau_w, unat(ijb:ije,:),120 .iip1*jjn*llm, ndexu)121 !$OMP END MASTER 122 123 C 124 CVents V125 C 126 127 128 129 !$OMP BARRIER 130 !$OMP MASTER 131 call histwrite(histvid, 'v', itau_w, vnat(ijb:ije,:),132 .iip1*jjn*llm, ndexv)133 !$OMP END MASTER 134 135 136 C 137 CTemperature potentielle138 C 139 140 141 142 !$OMP MASTER 143 call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),144 .iip1*jjn*llm, ndexu)145 !$OMP END MASTER 146 147 C 148 CTemperature149 C 150 151 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 152 153 154 155 156 79 ! 80 ! Initialisations 81 ! 82 if (adjust) return 83 84 IF (first) THEN 85 !$OMP BARRIER 86 !$OMP MASTER 87 ALLOCATE(unat(ijb_u:ije_u,llm)) 88 ALLOCATE(vnat(ijb_v:ije_v,llm)) 89 ALLOCATE(tm(ijb_u:ije_u,llm)) 90 ALLOCATE(ndex2d(ijnb_u*llm)) 91 ALLOCATE(ndexu(ijnb_u*llm)) 92 ALLOCATE(ndexv(ijnb_v*llm)) 93 ndex2d = 0 94 ndexu = 0 95 ndexv = 0 96 !$OMP END MASTER 97 !$OMP BARRIER 98 first=.FALSE. 99 ENDIF 100 101 ok_sync = .TRUE. 102 itau_w = itau_dyn + time 103 104 ! Passage aux composantes naturelles du vent 105 call covnat_loc(llm, ucov, vcov, unat, vnat) 106 107 ! 108 ! Appels a histwrite pour l'ecriture des variables a sauvegarder 109 ! 110 ! Vents U 111 ! 112 113 !$OMP BARRIER 114 !$OMP MASTER 115 ijb=ij_begin 116 ije=ij_end 117 jjn=jj_nb 118 119 call histwrite(histuid, 'u', itau_w, unat(ijb:ije,:), & 120 iip1*jjn*llm, ndexu) 121 !$OMP END MASTER 122 123 ! 124 ! Vents V 125 ! 126 ije=ij_end 127 if (pole_sud) jjn=jj_nb-1 128 if (pole_sud) ije=ij_end-iip1 129 !$OMP BARRIER 130 !$OMP MASTER 131 call histwrite(histvid, 'v', itau_w, vnat(ijb:ije,:), & 132 iip1*jjn*llm, ndexv) 133 !$OMP END MASTER 134 135 136 ! 137 ! Temperature potentielle 138 ! 139 ijb=ij_begin 140 ije=ij_end 141 jjn=jj_nb 142 !$OMP MASTER 143 call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:), & 144 iip1*jjn*llm, ndexu) 145 !$OMP END MASTER 146 147 ! 148 ! Temperature 149 ! 150 151 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 152 do ll=1,llm 153 do ii = ijb, ije 154 tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp 155 enddo 156 enddo 157 157 !$OMP ENDDO 158 158 159 !$OMP MASTER 160 call histwrite(histid, 'temp', itau_w, tm(ijb:ije,:),161 .iip1*jjn*llm, ndexu)162 !$OMP END MASTER 163 164 165 C 166 CGeopotentiel167 C 168 !$OMP MASTER 169 call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),170 .iip1*jjn*llm, ndexu)171 !$OMP END MASTER 172 173 174 C 175 CTraceurs176 C 177 !!$OMP MASTER 178 !DO iq=1,nqtot179 ! call histwrite(histid, tracers(iq)%longName, itau_w, 180 !. q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)181 !enddo182 !!$OMP END MASTER183 184 185 C 186 CMasse187 C 188 !$OMP MASTER 189 call histwrite(histid, 'masse', itau_w, masse(ijb:ije,:),190 .iip1*jjn*llm, ndexu)191 !$OMP END MASTER 192 193 194 C 195 CPression au sol196 C 197 !$OMP MASTER 198 call histwrite(histid, 'ps', itau_w, ps(ijb:ije),199 .iip1*jjn, ndex2d)200 !$OMP END MASTER 201 202 C 203 CGeopotentiel au sol204 C 205 !$OMP MASTER 206 !call histwrite(histid, 'phis', itau_w, phis(ijb:ije),207 !. iip1*jjn, ndex2d)208 !$OMP END MASTER 209 210 C 211 CFin212 C 213 !$OMP MASTER 214 215 216 217 218 159 !$OMP MASTER 160 call histwrite(histid, 'temp', itau_w, tm(ijb:ije,:), & 161 iip1*jjn*llm, ndexu) 162 !$OMP END MASTER 163 164 165 ! 166 ! Geopotentiel 167 ! 168 !$OMP MASTER 169 call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:), & 170 iip1*jjn*llm, ndexu) 171 !$OMP END MASTER 172 173 174 ! 175 ! Traceurs 176 ! 177 !!$OMP MASTER 178 ! DO iq=1,nqtot 179 ! call histwrite(histid, tracers(iq)%longName, itau_w, 180 ! . q(ijb:ije,:,iq), iip1*jjn*llm, ndexu) 181 ! enddo 182 !!$OMP END MASTER 183 184 185 ! 186 ! Masse 187 ! 188 !$OMP MASTER 189 call histwrite(histid, 'masse', itau_w, masse(ijb:ije,:), & 190 iip1*jjn*llm, ndexu) 191 !$OMP END MASTER 192 193 194 ! 195 ! Pression au sol 196 ! 197 !$OMP MASTER 198 call histwrite(histid, 'ps', itau_w, ps(ijb:ije), & 199 iip1*jjn, ndex2d) 200 !$OMP END MASTER 201 202 ! 203 ! Geopotentiel au sol 204 ! 205 !$OMP MASTER 206 ! call histwrite(histid, 'phis', itau_w, phis(ijb:ije), 207 ! . iip1*jjn, ndex2d) 208 !$OMP END MASTER 209 210 ! 211 ! Fin 212 ! 213 !$OMP MASTER 214 if (ok_sync) then 215 call histsync(histid) 216 call histsync(histvid) 217 call histsync(histuid) 218 endif 219 219 !$OMP END MASTER 220 220 #else 221 221 write(lunout,*)'writehist_loc: Needs IOIPSL to function' 222 222 #endif 223 ! #endif of #ifdef CPP_IOIPSL224 end 223 ! #endif of #ifdef CPP_IOIPSL 224 end subroutine writehist_loc
Note: See TracChangeset
for help on using the changeset viewer.