Changeset 4368 for LMDZ6/branches/Ocean_skin/libf/dyn3d_common
- Timestamp:
- Dec 6, 2022, 12:01:16 AM (2 years ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 11 edited
-
. (modified) (1 prop)
-
libf/dyn3d_common/comvert_mod.F90 (modified) (1 diff)
-
libf/dyn3d_common/control_mod.F90 (modified) (2 diffs)
-
libf/dyn3d_common/disvert.F90 (modified) (4 diffs)
-
libf/dyn3d_common/grilles_gcm_netcdf_sub.F90 (modified) (5 diffs)
-
libf/dyn3d_common/infotrac.F90 (modified) (2 diffs)
-
libf/dyn3d_common/initdynav.F90 (modified) (2 diffs)
-
libf/dyn3d_common/inithist.F (modified) (2 diffs)
-
libf/dyn3d_common/iso_verif_dyn.F (modified) (3 diffs)
-
libf/dyn3d_common/writedynav.F90 (modified) (2 diffs)
-
libf/dyn3d_common/writehist.F (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/comvert_mod.F90
r2602 r4368 10 10 11 11 PUBLIC :: ap,bp,presnivs,dpres,sig,ds,pa,preff,nivsigs,nivsig, & 12 aps,bps,scaleheight,pseudoalt,disvert_type, pressure_exner 12 aps,bps,scaleheight,pseudoalt,disvert_type, pressure_exner, & 13 presinter 13 14 14 15 REAL ap(llm+1) ! hybrid pressure contribution at interlayers 15 16 REAL bp (llm+1) ! hybrid sigma contribution at interlayer 16 17 REAL presnivs(llm) ! (reference) pressure at mid-layers 18 REAL presinter(llm+1) ! (reference) pressure at interlayers 17 19 REAL dpres(llm) 18 20 REAL sig(llm+1) -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/control_mod.F90
r2083 r4368 29 29 INTEGER,SAVE :: ip_ebil_dyn 30 30 LOGICAL,SAVE :: offline 31 CHARACTER(len=4),SAVE :: config_inca32 31 CHARACTER(len=10),SAVE :: planet_type ! planet type ('earth','mars',...) 33 32 LOGICAL,SAVE :: output_grads_dyn ! output dynamics diagnostics in … … 38 37 LOGICAL,SAVE :: ok_dyn_ave ! output averaged values of fields in the dynamics 39 38 ! in NetCDF files dyn_hist*ave.nc 39 LOGICAL,SAVE :: ok_dyn_xios ! xios outputs in dynamics 40 40 LOGICAL,SAVE :: resetvarc ! allows to reset the variables in sortvarc 41 41 -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/disvert.F90
r2786 r4368 11 11 use assert_m, only: assert 12 12 USE comvert_mod, ONLY: ap, bp, aps, bps, nivsigs, nivsig, dpres, presnivs, & 13 pseudoalt, pa, preff, scaleheight 13 pseudoalt, pa, preff, scaleheight, presinter 14 14 USE logic_mod, ONLY: ok_strato 15 15 … … 35 35 ! dpres(llm) !--- PRESSURE DIFFERENCE FOR EACH LAYER 36 36 ! presnivs(llm) !--- PRESSURE AT EACH MID-LAYER 37 ! presinter(llm+1) !--- PRESSURE AT EACH INTERFACE 37 38 ! scaleheight !--- VERTICAL SCALE HEIGHT (Earth: 8kms) 38 39 ! nivsig(llm+1) !--- SIGMA INDEX OF EACH LAYER INTERFACE … … 355 356 max(ap(l+1)+bp(l+1)*preff, 1.e-10)) 356 357 ENDDO 358 DO l=1, llmp1 359 presinter(l)= ( ap(l)+bp(l)*preff) 360 write(lunout, *)'PRESINTER(', l, ')=', presinter(l) 361 ENDDO 357 362 358 363 write(lunout, *) trim(modname),': PRESNIVS ' … … 395 400 ELSE IF(SIGN(f1,f4)/=f1) THEN; x2=xx; f2=f4 396 401 ELSE IF(SIGN(f2,f4)/=f2) THEN; x1=xx; f1=f4 397 ELSE; CALL abort_gcm("ridders",'Algorithm failed (which is odd...' )402 ELSE; CALL abort_gcm("ridders",'Algorithm failed (which is odd...', 1) 398 403 END IF 399 404 IF(ABS(10.*LOG(ABS(x2-x1)))<=1E-5) EXIT !--- ERROR ON SIG <= 0.01m -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90
r3811 r4368 2 2 ! $Id: $ 3 3 ! 4 ! This subroutine creates the file grilles_gcm.nc containg longitudes and 5 ! latitudes in degrees for grid u and v. This subroutine is called from 6 ! ce0l. This subroutine corresponds to the first 7 ! part in the program create_fausse_var. 4 ! This subroutine creates the grilles_gcm.nc file, containing: 5 ! -> longitudes and latitudes in degrees for dynamical grids u, v and scalaire, 6 ! and the following variables added for INCA (informative anyway) 7 ! -> vertical levels "presnivs" 8 ! -> mask (land/sea), area (grid), phis=surface geopotential height = phis/g 8 9 ! 10 ! The subroutine is called in dynphy_lonlat/phylmd/ce0l.F90. 11 9 12 SUBROUTINE grilles_gcm_netcdf_sub(masque,phis) 10 13 11 14 USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi 12 15 USE comvert_mod, ONLY: presnivs, preff, pa 16 use netcdf, only: nf90_def_var, nf90_int, nf90_float, nf90_put_var 13 17 14 18 IMPLICIT NONE … … 19 23 INCLUDE "netcdf.inc" 20 24 21 25 !======================== 22 26 REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: masque ! masque terre/mer 23 27 REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: phis ! geopotentiel au sol 24 28 25 REAL temp(iim+1,jjm+1) 26 ! Attributs netcdf sortie 29 INTEGER status,i,j 30 31 ! Attributs netcdf output 27 32 INTEGER ncid_out,rcode_out 28 INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid 29 INTEGER out_varid 33 34 INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid 35 INTEGER out_uid,out_vid,out_tempid 30 36 INTEGER out_lonudim,out_lonvdim 31 INTEGER out_latudim,out_latvdim,out_dim( 3)37 INTEGER out_latudim,out_latvdim,out_dim(2) 32 38 INTEGER out_levdim 33 34 INTEGER start(4),COUNT(4) 35 36 INTEGER status,i,j 37 REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm) 39 ! 40 INTEGER :: presnivs_id 41 INTEGER :: mask_id,area_id,phis_id 42 ! 43 INTEGER start(2),COUNT(2) 44 45 ! Variables 46 REAL rlatudeg(jjp1),rlatvdeg(jjm),rlev(llm) 38 47 REAL rlonudeg(iip1),rlonvdeg(iip1) 39 40 REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1) 41 REAL acoslat,dxkm,dykm,resol(iip1,jjp1) 42 REAL,DIMENSION(iip1,jjp1) :: phis_loc 48 REAL uwnd(iip1,jjp1),vwnd(iip1,jjm),temp(iip1,jjp1) 49 ! 43 50 INTEGER masque_int(iip1,jjp1) 44 INTEGER :: phis_id45 INTEGER :: area_id46 INTEGER :: mask_id47 INTEGER :: presnivs_id48 51 REAL :: phis_loc(iip1,jjp1) 52 53 !======================== 54 ! CALCULATION of latu, latv, lonu, lonv in deg. 55 ! --------------------------------------------------- 49 56 rad = 6400000 50 57 omeg = 7.272205e-05 … … 64 71 rlatudeg(j)=rlatu(j)*180./pi 65 72 ENDDO 73 66 74 DO j=1,jjm 67 75 rlatvdeg(j)=rlatv(j)*180./pi … … 72 80 rlonvdeg(i)=rlonv(i)*180./pi + 360. 73 81 ENDDO 74 75 76 ! 2 ----- OUVERTURE DE LA SORTIE NETCDF 77 ! --------------------------------------------------- 78 ! CREATION OUTPUT 79 ! ouverture fichier netcdf de sortie out 82 83 ! CALCULATION of "false" variables on u, v, s grids 84 ! --------------------------------------------------- 85 DO i=1,iip1 86 DO j=1,jjp1 87 uwnd(i,j)=MOD(i,2)+MOD(j,2) 88 temp(i,j)=MOD(i,2)+MOD(j,2) 89 ENDDO 90 DO j=1,jjm 91 vwnd(i,j)=MOD(i,2)+MOD(j,2) 92 END DO 93 ENDDO 94 95 ! CALCULATION of local vars for presnivs, mask, sfc. geopot. height 96 ! --------------------------------------------------- 97 rlev(:) = presnivs(:) 98 phis_loc(:,:) = phis(:,:)/g 99 masque_int(:,:) = nINT(masque(:,:)) 100 101 102 ! OPEN output netcdf file 103 !------------------------- 80 104 status=NF_CREATE('grilles_gcm.nc',IOR(NF_CLOBBER,NF_64BIT_OFFSET),ncid_out) 81 105 CALL handle_err(status) 106 107 ! DEFINE output dimensions 108 !------------------------- 82 109 status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim) 83 110 CALL handle_err(status) … … 88 115 status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim) 89 116 CALL handle_err(status) 90 91 92 ! Longitudes en u 93 status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid) 117 ! 118 status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim) 119 CALL handle_err(status) 120 121 ! DEFINE output variables 122 !------------------------- 123 ! Longitudes on "u" dynamical grid 124 status=NF90_DEF_VAR(ncid_out,'lonu',NF90_FLOAT,out_lonudim, out_lonuid) 94 125 CALL handle_err(status) 95 126 status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east') 96 status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u') 97 98 ! Longitudes en v 99 status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid) 127 status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',19,'Longitude on u grid') 128 ! Longitudes on "v" dynamical grid 129 status=NF90_DEF_VAR(ncid_out,'lonv',NF90_FLOAT,out_lonvdim, out_lonvid) 100 130 CALL handle_err(status) 101 131 status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east') 102 status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v') 103 104 ! Latitude en u 105 status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid) 132 status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 19,'Longitude on v grid') 133 ! Latitudes on "u" dynamical grid 134 status=NF90_DEF_VAR(ncid_out,'latu',NF90_FLOAT,out_latudim, out_latuid) 106 135 CALL handle_err(status) 107 136 status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north') 108 status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u') 109 110 ! Latitude en v 111 status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid) 137 status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 18,'Latitude on u grid') 138 ! Latitudes on "v" dynamical grid 139 status=NF90_DEF_VAR(ncid_out,'latv',NF90_FLOAT,out_latvdim, out_latvid) 112 140 CALL handle_err(status) 113 141 status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north') 114 status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v') 115 116 ! ecriture de la grille u 142 status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 18,'Latitude on v grid') 143 ! "u" lat/lon dynamical grid 117 144 out_dim(1)=out_lonudim 118 145 out_dim(2)=out_latudim 119 status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid) 120 CALL handle_err(status) 121 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') 122 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u') 123 124 ! ecriture de la grille v 146 status=NF90_DEF_VAR(ncid_out,'grille_u',NF90_FLOAT,out_dim, out_uid) 147 CALL handle_err(status) 148 status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'units', 3,'m/s') 149 status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'long_name', 21,'u-wind dynamical grid') 150 ! "v" lat/lon dynamical grid 125 151 out_dim(1)=out_lonvdim 126 152 out_dim(2)=out_latvdim 127 status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid) 128 CALL handle_err(status) 129 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') 130 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v') 131 132 ! ecriture de la grille u 153 status=NF90_DEF_VAR(ncid_out,'grille_v',NF90_FLOAT,out_dim, out_vid) 154 CALL handle_err(status) 155 status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'units', 3,'m/s') 156 status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'long_name', 21,'v-wind dynamical grid') 157 ! "s" (scalar) lat/lon dynamical grid 133 158 out_dim(1)=out_lonvdim 134 159 out_dim(2)=out_latudim 135 status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid) 136 CALL handle_err(status) 137 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') 138 status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u') 139 140 status=NF_ENDDEF(ncid_out) 141 write(*,*) "COUCOU 6" 142 CALL handle_err(status) 143 ! 5) ----- FERMETURE DES FICHIERS NETCDF------------------ 144 ! -------------------------------------------------------- 145 ! 3-b- Ecriture de la grille pour la sortie 146 ! rajoute l'ecriture de la grille 147 148 #ifdef NC_DOUBLE 149 status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg) 150 CALL handle_err(status) 151 status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg) 152 CALL handle_err(status) 153 status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg) 154 CALL handle_err(status) 155 status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg) 156 CALL handle_err(status) 157 #else 158 status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg) 159 CALL handle_err(status) 160 status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg) 161 CALL handle_err(status) 162 status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg) 163 CALL handle_err(status) 164 status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg) 165 CALL handle_err(status) 166 #endif 167 168 start(1)=1 169 start(2)=1 170 start(3)=1 171 start(4)=1 172 173 COUNT(1)=iim+1 174 COUNT(2)=jjm+1 175 COUNT(3)=1 176 COUNT(4)=1 177 178 DO j=1,jjm+1 179 DO i=1,iim+1 180 temp(i,j)=MOD(i,2)+MOD(j,2) 181 ENDDO 182 ENDDO 183 184 #ifdef NC_DOUBLE 185 status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp) 186 CALL handle_err(status) 187 #else 188 status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, count,temp) 189 CALL handle_err(status) 190 #endif 191 192 ! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA 193 ! lev - phis - aire - mask 194 ! rlevdeg(:) = presnivs 195 rlevdeg(:) = presnivs(:) 196 phis_loc(:,:) = phis(:,:)/g 197 198 ! niveaux de pression verticaux 199 status = NF_REDEF (ncid_out) 200 CALL handle_err(status) 201 status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim) 202 CALL handle_err(status) 203 status=NF_DEF_VAR(ncid_out,'presnivs',NF_FLOAT,1,out_levdim,& 204 presnivs_id) 205 CALL handle_err(status) 206 207 ! fields 160 status=NF90_DEF_VAR(ncid_out,'grille_s',NF90_FLOAT,out_dim, out_tempid) 161 CALL handle_err(status) 162 status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'units', 6,'Kelvin') 163 status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'long_name',21,'scalar dynamical grid') 164 ! 165 ! for INCA : 166 ! vertical levels "presnivs" 167 status=NF90_DEF_VAR(ncid_out,'presnivs',NF90_FLOAT,out_levdim, presnivs_id) 168 CALL handle_err(status) 169 status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'units', 2,'Pa') 170 status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'long_name',15,'Vertical levels') 171 ! surface geopotential height: named "phis" as the sfc geopotential, is actually phis/g 208 172 out_dim(1)=out_lonvdim 209 173 out_dim(2)=out_latudim 210 211 status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id) 212 CALL handle_err(status) 213 status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id) 214 CALL handle_err(status) 215 status = nf_def_var(ncid_out,'mask',NF_INT ,2,out_dim,mask_id) 216 CALL handle_err(status) 217 218 status=NF_ENDDEF(ncid_out) 219 CALL handle_err(status) 220 221 ! ecriture des variables 222 #ifdef NC_DOUBLE 223 status=NF_PUT_VARA_DOUBLE(ncid_out,presnivs_id,1,llm,rlevdeg) 224 CALL handle_err(status) 225 #else 226 status=NF_PUT_VARA_REAL(ncid_out,out_levid,1,llm,rlevdeg) 227 CALL handle_err(status) 228 #endif 229 230 start(1)=1 231 start(2)=1 232 start(3)=1 233 start(4)=0 174 status = nf90_def_var(ncid_out,'phis',NF90_FLOAT,out_dim,phis_id) 175 CALL handle_err(status) 176 status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'units', 1,'m') 177 status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'long_name',27,'surface geopotential height') 178 ! gridcell area 179 status = nf90_def_var(ncid_out,'aire',NF90_FLOAT,out_dim,area_id) 180 CALL handle_err(status) 181 status=NF_PUT_ATT_TEXT(ncid_out,area_id,'units', 2,'m2') 182 status=NF_PUT_ATT_TEXT(ncid_out,area_id,'long_name',13,'gridcell area') 183 ! land-sea mask (nearest integer approx) 184 status = nf90_def_var(ncid_out,'mask',NF90_INT,out_dim,mask_id) 185 CALL handle_err(status) 186 status=NF_PUT_ATT_TEXT(ncid_out,mask_id,'long_name',27,'land-sea mask (nINT approx)') 187 188 ! END the 'define' mode in netCDF file 189 status=NF_ENDDEF(ncid_out) 190 CALL handle_err(status) 191 192 ! WRITE the variables 193 !------------------------- 194 ! 1D : lonu, lonv,latu,latv ; INCA : presnivs 195 status=NF90_PUT_VAR(ncid_out,out_lonuid,rlonudeg,[1],[iip1]) 196 CALL handle_err(status) 197 status=NF90_PUT_VAR(ncid_out,out_lonvid,rlonvdeg,[1],[iip1]) 198 CALL handle_err(status) 199 status=NF90_PUT_VAR(ncid_out,out_latuid,rlatudeg,[1],[jjp1]) 200 CALL handle_err(status) 201 status=NF90_PUT_VAR(ncid_out,out_latvid,rlatvdeg,[1],[jjm]) 202 CALL handle_err(status) 203 status=NF90_PUT_VAR(ncid_out,presnivs_id,rlev,[1],[llm]) 204 CALL handle_err(status) 205 206 ! 2D : grille_u,grille_v,grille_s ; INCA: phis,aire,mask 207 start(:)=1 234 208 COUNT(1)=iip1 235 COUNT(2)=jjp1 236 COUNT(3)=1 237 COUNT(4)=0 238 239 status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc) 240 CALL handle_err(status) 241 status = nf_put_vara_double(ncid_out, area_id,start,count, aire) 242 CALL handle_err(status) 243 masque_int(:,:) = nINT(masque(:,:)) 244 status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int) 245 CALL handle_err(status) 246 247 ! fermeture du fichier netcdf 209 210 COUNT(2)=jjp1 ! for "u" and "s" grids 211 status=NF90_PUT_VAR(ncid_out,out_uid,uwnd,start, count) 212 CALL handle_err(status) 213 COUNT(2)=jjm ! for "v" grid 214 status=NF90_PUT_VAR(ncid_out,out_vid,vwnd,start, count) 215 CALL handle_err(status) 216 COUNT(2)=jjp1 ! as "s" grid, for all the following vars 217 status=NF90_PUT_VAR(ncid_out,out_tempid,temp,start, count) 218 CALL handle_err(status) 219 status = nf90_put_var(ncid_out, phis_id, phis_loc,start,count) 220 CALL handle_err(status) 221 status = nf90_put_var(ncid_out, area_id, aire,start,count) 222 CALL handle_err(status) 223 status = nf90_put_var(ncid_out, mask_id,masque_int,start,count) 224 CALL handle_err(status) 225 226 ! CLOSE netcdf file 248 227 CALL ncclos(ncid_out,rcode_out) 228 write(*,*) "END grilles_gcm_netcdf_sub OK" 249 229 250 230 END SUBROUTINE grilles_gcm_netcdf_sub 251 252 231 253 232 -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/infotrac.F90
r4013 r4368 1 ! 1 !$Id$ 2 2 ! 3 3 MODULE infotrac 4 4 5 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 6 INTEGER, SAVE :: nqtot 7 !CR: on ajoute le nombre de traceurs de l eau 8 INTEGER, SAVE :: nqo 9 10 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid 11 ! number of tracers used in the physics 12 INTEGER, SAVE :: nbtr 13 14 ! CRisi: on retranche les isotopes des traceurs habituels 15 ! On fait un tableaux d'indices des traceurs qui passeront dans phytrac 16 INTEGER, SAVE :: nqtottr 17 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: itr_indice 18 19 ! CRisi: nb traceurs peres= directement advectes par l'air 20 INTEGER, SAVE :: nqperes 21 22 ! ThL: nb traceurs INCA 23 INTEGER, SAVE :: nqINCA 24 25 ! ThL: nb traceurs CO2 26 INTEGER, SAVE :: nqCO2 27 28 ! Name variables 29 INTEGER,PARAMETER :: tname_lenmax=128 30 CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics 31 CHARACTER(len=tname_lenmax+3), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics 32 33 ! iadv : index of trasport schema for each tracer 34 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv 35 36 ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 37 ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 38 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique 39 40 ! CRisi: tableaux de fils 41 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils 42 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les generations 43 INTEGER, SAVE :: nqdesc_tot 44 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils 45 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere 46 REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi 47 PARAMETER (qperemin=1e-16,masseqmin=1e-16,ratiomin=1e-16) ! MVals 48 49 ! conv_flg(it)=0 : convection desactivated for tracer number it 50 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg 51 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it 52 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg 53 54 CHARACTER(len=4),SAVE :: type_trac 55 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 56 57 ! CRisi: cas particulier des isotopes 58 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 59 INTEGER :: niso_possibles 60 PARAMETER ( niso_possibles=5) 61 REAL, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 62 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 63 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 64 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numero iso entre 1 et niso_possibles en fn de nqtot 65 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot 66 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numero de la zone de tracage en fn de nqtot 67 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numero de la zone de tracage en fn de nqtot 68 INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles 69 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numero ixt en fn izone, indnum entre 1 et niso 70 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 71 72 #ifdef CPP_StratAer 73 !--CK/OB for stratospheric aerosols 74 INTEGER, SAVE :: nbtr_bin 75 INTEGER, SAVE :: nbtr_sulgas 76 INTEGER, SAVE :: id_OCS_strat 77 INTEGER, SAVE :: id_SO2_strat 78 INTEGER, SAVE :: id_H2SO4_strat 79 INTEGER, SAVE :: id_BIN01_strat 80 INTEGER, SAVE :: id_TEST_strat 81 #endif 82 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse 6 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, & 7 getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, & 8 indexUpdate, isoSelect, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, nphas, nzone, niso 9 IMPLICIT NONE 10 11 PRIVATE 12 13 !=== FOR TRACERS: 14 PUBLIC :: init_infotrac !--- Initialization of the tracers 15 PUBLIC :: tracers, type_trac, types_trac !--- Full tracers database, tracers type keyword 16 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 18 19 !=== FOR ISOTOPES: General 20 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 21 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 22 !=== FOR ISOTOPES: Specific to water 23 PUBLIC :: iH2O !--- H2O isotopes class index 24 PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities 25 !=== FOR ISOTOPES: Depending on the selected isotopes family 26 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 27 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 28 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 29 PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx) 30 PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases 31 PUBLIC :: isoCheck !--- Run isotopes checking routines 32 !=== FOR BOTH TRACERS AND ISOTOPES 33 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 34 35 !=== CONVENTIONS FOR TRACERS NUMBERS: 36 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 37 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 38 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 39 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 40 ! | | | | | | 41 ! |<-- nqo -->|<-- nqo*niso* nzone -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 42 ! | | | | 43 ! | |<-- nqo*niso*(nzone+1) = nqo*ntiso -->|<-- nqtottr = nbtr + nmom -->| 44 ! | = nqtot - nqo*(ntiso+1) | 45 ! | | 46 ! |<-- nqtrue = nbtr + nqo*(ntiso+1) -->| | 47 ! | | 48 ! |<-- nqtot = nqtrue + nmom -->| 49 ! | | 50 ! |-----------------------------------------------------------------------------------------------------------| 51 ! NOTES FOR THIS TABLE: 52 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 53 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 54 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 55 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 56 ! 57 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) 58 ! Each entry is accessible using "%" sign. 59 ! |-------------+------------------------------------------------------+-------------+------------------------+ 60 ! | entry | Meaning | Former name | Possible values | 61 ! |-------------+------------------------------------------------------+-------------+------------------------+ 62 ! | name | Name (short) | tname | | 63 ! | gen0Name | Name of the 1st generation ancestor | / | | 64 ! | parent | Name of the parent | / | | 65 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 66 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 67 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 68 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 69 ! | iGeneration | Generation (>=1) | / | | 70 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 71 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 72 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 73 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 74 ! | keys | key/val pairs accessible with "getKey" routine | / | | 75 ! | iadv | Advection scheme number | iadv | 1,2,10-20(exc.15,19),30| 76 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 77 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 78 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 79 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 80 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 81 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 82 ! +-------------+------------------------------------------------------+-------------+------------------------+ 83 ! 84 !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES) 85 ! Each entry is accessible using "%" sign. 86 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 87 ! | entry | length | Meaning | Former name | Possible values | 88 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 89 ! | parent | Parent tracer (isotopes family name) | | | 90 ! | keys | niso | Isotopes keys/values pairs list + number | | | 91 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 92 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 93 ! | phase | nphas | Phases list + number | | [g][l][s], 1:3 | 94 ! | iqIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 95 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | 96 ! +-----------------+--------------------------------------------------+--------------------+-----------------+ 97 98 REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi 99 100 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 101 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 102 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 103 nqo, & !--- Number of water phases 104 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 105 nqCO2 !--- Number of tracers of CO2 (ThL) 106 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 107 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 108 109 !=== VARIABLES FOR INCA 110 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 111 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 112 83 113 CONTAINS 84 114 85 SUBROUTINE infotrac_init 86 USE control_mod, ONLY: planet_type, config_inca115 SUBROUTINE init_infotrac 116 USE control_mod, ONLY: planet_type 87 117 #ifdef REPROBUS 88 USE CHEM_REP, ONLY: Init_chem_rep_trac89 #endif 90 91 !======================================================================= 118 USE CHEM_REP, ONLY: Init_chem_rep_trac 119 #endif 120 IMPLICIT NONE 121 !============================================================================================================================== 92 122 ! 93 123 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin 94 124 ! ------- 95 ! Modif special traceur F.Forget 05/94 96 ! Modif M-A Filiberti 02/02 lecture de traceur.def 125 ! 126 ! Modifications: 127 ! -------------- 128 ! 05/94: F.Forget Modif special traceur 129 ! 02/02: M-A Filiberti Lecture de traceur.def 130 ! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type) 97 131 ! 98 132 ! Objet: … … 100 134 ! GCM LMD nouvelle grille 101 135 ! 102 !======================================================================= 136 !============================================================================================================================== 103 137 ! ... modification de l'integration de q ( 26/04/94 ) .... 104 !----------------------------------------------------------------------- 105 ! Declarations 106 107 INCLUDE "dimensions.h"108 INCLUDE "iniprint.h" 109 138 !------------------------------------------------------------------------------------------------------------------------------ 139 ! Declarations: 140 INCLUDE "dimensions.h" 141 INCLUDE "iniprint.h" 142 143 !------------------------------------------------------------------------------------------------------------------------------ 110 144 ! Local variables 111 INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv ! index of horizontal trasport schema 112 INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv ! index of vertical trasport schema 113 114 INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv_inca ! index of horizontal trasport schema 115 INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv_inca ! index of vertical trasport schema 116 117 INTEGER, ALLOCATABLE, DIMENSION(:) :: conv_flg_inca 118 INTEGER, ALLOCATABLE, DIMENSION(:) :: pbl_flg_inca 119 CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: solsym_inca 120 121 CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name 122 CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi 123 CHARACTER(len=3), DIMENSION(30) :: descrq 124 CHARACTER(len=1), DIMENSION(3) :: txts 125 CHARACTER(len=2), DIMENSION(9) :: txtp 126 CHARACTER(len=tname_lenmax) :: str1,str2 127 128 INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment 129 INTEGER :: iq, new_iq, iiq, jq, ierr,itr 130 INTEGER :: ifils,ipere,generation ! CRisi 131 LOGICAL :: continu,nouveau_traceurdef 132 INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def 133 CHARACTER(len=2*tname_lenmax+1) :: tchaine 134 135 character(len=*),parameter :: modname="infotrac_init" 136 137 !----------------------------------------------------------------------- 145 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number 146 #ifdef INCA 147 INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA 148 vad (:), vadv_inca(:), pbl_flg_inca(:) 149 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA 150 INTEGER :: nqINCA 151 #endif 152 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 153 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 154 CHARACTER(LEN=maxlen) :: msg1 !--- String for messages 155 INTEGER :: fType !--- Tracers description file type ; 0: none 156 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 157 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 158 INTEGER :: iad !--- Advection scheme number 159 INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables 160 LOGICAL :: lerr, ll, lRepr 161 CHARACTER(LEN=1) :: p 162 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 163 TYPE(trac_type), POINTER :: t1, t(:) 164 INTEGER :: ierr 165 166 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac" 167 !------------------------------------------------------------------------------------------------------------------------------ 138 168 ! Initialization : 139 ! 140 txts=(/'x','y','z'/) 141 txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/) 142 143 descrq(14)='VLH' 144 descrq(10)='VL1' 145 descrq(11)='VLP' 146 descrq(12)='FH1' 147 descrq(13)='FH2' 148 descrq(16)='PPM' 149 descrq(17)='PPS' 150 descrq(18)='PPP' 151 descrq(20)='SLP' 152 descrq(30)='PRA' 169 !------------------------------------------------------------------------------------------------------------------------------ 170 suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz'] 171 descrq( 1: 2) = ['LMV','BAK'] 172 descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP'] 173 descrq(30) = 'PRA' 153 174 154 155 ! Coherence test between parameter type_trac, config_inca and preprocessing keys 156 IF (type_trac=='inca') THEN 157 WRITE(lunout,*) 'You have chosen to couple with INCA chemistry model : type_trac=', & 158 type_trac,' config_inca=',config_inca 159 IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN 160 WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def' 161 CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1) 162 ENDIF 175 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 176 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 177 178 !--------------------------------------------------------------------------------------------------------------------------- 179 DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list 180 !--------------------------------------------------------------------------------------------------------------------------- 181 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 182 msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":' 183 SELECT CASE(types_trac(it)) 184 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname) 185 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 186 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 187 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 188 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 189 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 190 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1) 191 END SELECT 192 193 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 194 SELECT CASE(types_trac(it)) 195 CASE('inca', 'inco') 163 196 #ifndef INCA 164 WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code' 165 CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1) 166 #endif 167 ELSE IF (type_trac=='repr') THEN 168 WRITE(lunout,*) 'You have chosen to couple with REPROBUS chemestry model : type_trac=', type_trac 197 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 198 #endif 199 CASE('repr') 169 200 #ifndef REPROBUS 170 WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code' 171 CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1) 172 #endif 173 ELSE IF (type_trac == 'co2i') THEN 174 WRITE(lunout,*) 'You have chosen to run with CO2 cycle: type_trac=', type_trac 175 ELSE IF (type_trac == 'coag') THEN 176 WRITE(lunout,*) 'Tracers are treated for COAGULATION tests : type_trac=', type_trac 201 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 202 #endif 203 CASE('coag') 177 204 #ifndef CPP_StratAer 178 WRITE(lunout,*) 'To run this option you must add cpp key StratAer and compile with StratAer code' 179 CALL abort_gcm('infotrac_init','You must compile with cpp key StratAer',1) 180 #endif 181 ELSE IF (type_trac == 'lmdz') THEN 182 WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac 183 ELSE IF (type_trac == 'inco') THEN ! ThL 184 WRITE(lunout,*) 'Using jointly INCA and CO2 cycle: type_trac =', type_trac 185 IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN 186 WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def' 187 CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1) 188 ENDIF 189 #ifndef INCA 190 WRITE(lunout,*) 'To run this option you must add cpp key INCA and compilewith INCA code' 191 CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1) 192 #endif 193 ELSE 194 WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops' 195 CALL abort_gcm('infotrac_init','bad parameter',1) 196 ENDIF 197 198 ! Test if config_inca is other then none for run without INCA 199 IF (type_trac/='inca' .AND. type_trac/='inco' .AND. config_inca/='none') THEN 200 WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model' 201 config_inca='none' 202 ENDIF 203 204 !----------------------------------------------------------------------- 205 ! 206 ! 1) Get the true number of tracers + water vapor/liquid 207 ! Here true tracers (nqtrue) means declared tracers (only first order) 208 ! 209 !----------------------------------------------------------------------- 210 IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN 211 IF (type_trac=='co2i') THEN 212 nqCO2 = 1 213 ELSE 214 nqCO2 = 0 215 ENDIF 216 OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) 217 IF(ierr.EQ.0) THEN 218 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 219 READ(90,*) nqtrue 220 write(lunout,*) 'nqtrue=',nqtrue 221 ELSE 222 WRITE(lunout,*) trim(modname),': Failed opening traceur.def' 223 CALL abort_gcm(modname,"file traceur.def not found!",1) 224 ENDIF 225 !jyg< 226 !! if ( planet_type=='earth') then 227 !! ! For Earth, water vapour & liquid tracers are not in the physics 228 !! nbtr=nqtrue-2 229 !! else 230 !! ! Other planets (for now); we have the same number of tracers 231 !! ! in the dynamics than in the physics 232 !! nbtr=nqtrue 233 !! endif 234 !>jyg 235 ELSE ! type_trac=inca or inco 236 IF (type_trac=='inco') THEN 237 nqCO2 = 1 238 ELSE 239 nqCO2 = 0 240 ENDIF 241 !jyg< 242 ! The traceur.def file is used to define the number "nqo" of water phases 243 ! present in the simulation. Default : nqo = 2. 244 OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) 245 IF(ierr.EQ.0) THEN 246 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 247 READ(90,*) nqo 248 ELSE 249 WRITE(lunout,*) trim(modname),': Failed opening traceur.def' 250 CALL abort_gcm(modname,"file traceur.def not found!",1) 251 ENDIF 252 IF (nqo /= 2 .AND. nqo /= 3 ) THEN 253 IF (nqo == 4 .AND. type_trac=='inco') THEN ! ThL 254 WRITE(lunout,*) trim(modname),': you are coupling with INCA, and also using CO2i.' 255 nqo = 3 ! A ameliorier... je force 3 traceurs eau... ThL 256 WRITE(lunout,*) trim(modname),': nqo = ',nqo 257 ELSE 258 WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowed. Only 2 or 3 water phases allowed' 259 CALL abort_gcm('infotrac_init','Bad number of water phases',1) 260 ENDIF 261 ENDIF 262 ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 205 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 206 #endif 207 END SELECT 208 209 !--------------------------------------------------------------------------------------------------------------------------- 210 END DO 211 !--------------------------------------------------------------------------------------------------------------------------- 212 213 nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] ) 214 215 !============================================================================================================================== 216 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 217 !============================================================================================================================== 218 lRepr = ANY(types_trac(:) == 'repr') 219 IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 220 !--------------------------------------------------------------------------------------------------------------------------- 221 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 222 !--------------------------------------------------------------------------------------------------------------------------- 223 IF(fType == 1 .AND. ANY(['inca','inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" (single type_trac) 224 !--------------------------------------------------------------------------------------------------------------------------- 263 225 #ifdef INCA 264 CALL Init_chem_inca_trac(nqINCA) 265 #else 266 nqINCA=0 267 #endif 268 nbtr=nqINCA+nqCO2 269 nqtrue=nbtr+nqo 270 WRITE(lunout,*) trim(modname),': nqo = ',nqo 271 WRITE(lunout,*) trim(modname),': nbtr = ',nbtr 272 WRITE(lunout,*) trim(modname),': nqtrue = ',nqtrue 273 WRITE(lunout,*) trim(modname),': nqCO2 = ',nqCO2 274 WRITE(lunout,*) trim(modname),': nqINCA = ',nqINCA 275 ALLOCATE(hadv_inca(nqINCA), vadv_inca(nqINCA), conv_flg_inca(nqINCA), pbl_flg_inca(nqINCA), solsym_inca(nqINCA)) 276 ENDIF ! type_trac 'inca' ou 'inco' 277 !>jyg 278 279 IF ((planet_type=="earth").and.(nqtrue < 2)) THEN 280 WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowed. 2 tracers is the minimum' 281 CALL abort_gcm('infotrac_init','Not enough tracers',1) 282 ENDIF 283 284 !jyg< 285 286 ! 287 ! Allocate variables depending on nqtrue 288 ! 289 ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue)) 290 291 292 !----------------------------------------------------------------------- 293 ! 2) Choix des schemas d'advection pour l'eau et les traceurs 294 ! 295 ! iadv = 1 schema transport type "humidite specifique LMD" 296 ! iadv = 2 schema amont 297 ! iadv = 14 schema Van-leer + humidite specifique 298 ! Modif F.Codron 299 ! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide) 300 ! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv 301 ! iadv = 12 schema Frederic Hourdin I 302 ! iadv = 13 schema Frederic Hourdin II 303 ! iadv = 16 schema PPM Monotone(Collela & Woodward 1984) 304 ! iadv = 17 schema PPM Semi Monotone (overshoots autorises) 305 ! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorises) 306 ! iadv = 20 schema Slopes 307 ! iadv = 30 schema Prather 308 ! 309 ! Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur 310 ! iq = 2 pour l'eau liquide 311 ! Et eventuellement iq = 3,nqtot pour les autres traceurs 312 ! 313 ! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq. 314 !------------------------------------------------------------------------ 315 ! 316 ! Get choice of advection schema from file tracer.def or from INCA 317 !--------------------------------------------------------------------- 318 IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN 319 320 ! Continue to read tracer.def 321 DO iq=1,nqtrue 322 323 write(*,*) 'infotrac 237: iq=',iq 324 ! CRisi: ajout du nom du fluide transporteur 325 ! mais rester retro compatible 326 READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine 327 write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq) 328 write(lunout,*) 'tchaine=',trim(tchaine) 329 write(*,*) 'infotrac 238: IOstatus=',IOstatus 330 if (IOstatus.ne.0) then 331 CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1) 332 endif 333 ! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un 334 ! espace ou pas au milieu de la chaine. 335 continu=.true. 336 nouveau_traceurdef=.false. 337 iiq=1 338 do while (continu) 339 if (tchaine(iiq:iiq).eq.' ') then 340 nouveau_traceurdef=.true. 341 continu=.false. 342 else if (iiq.lt.LEN_TRIM(tchaine)) then 343 iiq=iiq+1 344 else 345 continu=.false. 346 endif 347 enddo 348 write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef 349 if (nouveau_traceurdef) then 350 write(lunout,*) 'C''est la nouvelle version de traceur.def' 351 tnom_0(iq)=tchaine(1:iiq-1) 352 tnom_transp(iq)=tchaine(iiq+1:) 353 else 354 write(lunout,*) 'C''est l''ancienne version de traceur.def' 355 write(lunout,*) 'On suppose que les traceurs sont tous d''air' 356 tnom_0(iq)=tchaine 357 tnom_transp(iq) = 'air' 358 endif 359 write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>' 360 write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>' 361 362 ENDDO!DO iq=1,nqtrue 363 364 CLOSE(90) 365 366 WRITE(lunout,*) trim(modname),': Valeur de traceur.def :' 367 WRITE(lunout,*) trim(modname),': nombre total de traceurs ',nqtrue 368 DO iq=1,nqtrue 369 WRITE(lunout,*) hadv(iq),vadv(iq),' ',trim(tnom_0(iq)),' ',trim(tnom_transp(iq)) 370 END DO 371 372 IF ( planet_type=='earth') THEN 373 !CR: nombre de traceurs de l eau 374 IF (tnom_0(3) == 'H2Oi') THEN 375 nqo=3 376 ELSE 377 nqo=2 378 ENDIF 379 ! For Earth, water vapour & liquid tracers are not in the physics 380 nbtr=nqtrue-nqo 381 ELSE 382 ! Other planets (for now); we have the same number of tracers 383 ! in the dynamics than in the physics 384 nbtr=nqtrue 385 ENDIF 386 387 #ifdef CPP_StratAer 388 IF (type_trac == 'coag') THEN 389 nbtr_bin=0 390 nbtr_sulgas=0 391 DO iq=1,nqtrue 392 IF (tnom_0(iq)(1:3)=='BIN') THEN !check if tracer name contains 'BIN' 393 nbtr_bin=nbtr_bin+1 394 ENDIF 395 IF (tnom_0(iq)(1:3)=='GAS') THEN !check if tracer name contains 'GAS' 396 nbtr_sulgas=nbtr_sulgas+1 397 ENDIF 398 ENDDO 399 print*,'nbtr_bin=',nbtr_bin 400 print*,'nbtr_sulgas=',nbtr_sulgas 401 DO iq=1,nqtrue 402 IF (tnom_0(iq)=='GASOCS') THEN 403 id_OCS_strat=iq-nqo 404 ENDIF 405 IF (tnom_0(iq)=='GASSO2') THEN 406 id_SO2_strat=iq-nqo 407 ENDIF 408 IF (tnom_0(iq)=='GASH2SO4') THEN 409 id_H2SO4_strat=iq-nqo 410 ENDIF 411 IF (tnom_0(iq)=='BIN01') THEN 412 id_BIN01_strat=iq-nqo 413 ENDIF 414 IF (tnom_0(iq)=='GASTEST') THEN 415 id_TEST_strat=iq-nqo 416 ENDIF 417 ENDDO 418 print*,'id_OCS_strat =',id_OCS_strat 419 print*,'id_SO2_strat =',id_SO2_strat 420 print*,'id_H2SO4_strat=',id_H2SO4_strat 421 print*,'id_BIN01_strat=',id_BIN01_strat 422 ENDIF 423 #endif 424 425 ENDIF ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag' .OR. type_trac = 'co2i') 426 !jyg< 427 ! 428 429 ! Transfert number of tracers to Reprobus 430 IF (type_trac == 'repr') THEN 226 nqo = SIZE(tracers) - nqCO2 227 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 228 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 229 nqtrue = nbtr + nqo !--- Total number of "true" tracers 230 IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 231 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 232 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 233 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 234 ALLOCATE(ttr(nqtrue)) 235 ttr(1:nqo+nqCO2) = tracers 236 ttr(1 : nqo )%component = 'lmdz' 237 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 238 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 239 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca] 240 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 241 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 242 lerr = getKey('hadv', had, ky=tracers(:)%keys) 243 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 244 hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca 245 vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca 246 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 247 CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name 248 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 249 #endif 250 !--------------------------------------------------------------------------------------------------------------------------- 251 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 252 !--------------------------------------------------------------------------------------------------------------------------- 253 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 254 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 255 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 256 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 257 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 258 #ifdef INCA 259 nqINCA = COUNT(tracers(:)%component == 'inca') 260 #endif 261 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 262 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 263 !--------------------------------------------------------------------------------------------------------------------------- 264 END IF 265 !--------------------------------------------------------------------------------------------------------------------------- 266 267 !--- Transfert the number of tracers to Reprobus 431 268 #ifdef REPROBUS 432 CALL Init_chem_rep_trac(nbtr,nqo,tnom_0) 433 #endif 434 ENDIF 435 ! 436 ! Allocate variables depending on nbtr 437 ! 438 ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr)) 439 conv_flg(:) = 1 ! convection activated for all tracers 440 pbl_flg(:) = 1 ! boundary layer activated for all tracers 441 442 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! config_inca='aero' ou 'chem' 443 !>jyg 444 ! le module de chimie fournit les noms des traceurs 445 ! et les schemas d'advection associes. excepte pour ceux lus 446 ! dans traceur.def 447 448 DO iq=1,nqo+nqCO2 449 450 write(*,*) 'infotrac 237: iq=',iq 451 ! CRisi: ajout du nom du fluide transporteur 452 ! mais rester retro compatible 453 READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine 454 write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq) 455 write(lunout,*) 'tchaine=',trim(tchaine) 456 write(*,*) 'infotrac 238: IOstatus=',IOstatus 457 if (IOstatus.ne.0) then 458 CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1) 459 endif 460 ! Y-a-t-il 1 ou 2 noms de traceurs? -> On regarde s'il y a un 461 ! espace ou pas au milieu de la chaine. 462 continu=.true. 463 nouveau_traceurdef=.false. 464 iiq=1 465 466 do while (continu) 467 if (tchaine(iiq:iiq).eq.' ') then 468 nouveau_traceurdef=.true. 469 continu=.false. 470 else if (iiq.lt.LEN_TRIM(tchaine)) then 471 iiq=iiq+1 472 else 473 continu=.false. 474 endif 475 enddo 476 477 write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef 478 479 if (nouveau_traceurdef) then 480 write(lunout,*) 'C''est la nouvelle version de traceur.def' 481 tnom_0(iq)=tchaine(1:iiq-1) 482 tnom_transp(iq)=tchaine(iiq+1:) 483 else 484 write(lunout,*) 'C''est l''ancienne version de traceur.def' 485 write(lunout,*) 'On suppose que les traceurs sont tous d''air' 486 tnom_0(iq)=tchaine 487 tnom_transp(iq) = 'air' 488 endif 489 490 write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>' 491 write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>' 492 493 ENDDO !DO iq=1,nqo 494 CLOSE(90) 495 496 269 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 270 #endif 271 272 !============================================================================================================================== 273 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 274 !============================================================================================================================== 275 DO iq = 1, nqtrue 276 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE 277 WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available' 278 CALL abort_gcm(modname, TRIM(msg1), 1) 279 END DO 280 nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer 281 + 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers 282 + 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers 283 284 !--- More tracers due to the choice of advection scheme => assign total number of tracers 285 IF( nqtot /= nqtrue ) THEN 286 CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers') 287 CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue))) 288 CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot))) 289 END IF 290 291 !============================================================================================================================== 292 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected. 293 ! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV 294 ! iadv = 2 backward (for H2O liquid) BAK 295 ! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH 296 ! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1 297 ! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP 298 ! iadv = 12 Frederic Hourdin I FH1 299 ! iadv = 13 Frederic Hourdin II FH2 300 ! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM 301 ! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS 302 ! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP 303 ! iadv = 20 Slopes SLP 304 ! iadv = 30 Prather PRA 305 ! 306 ! In array q(ij,l,iq) : iq = 1/2[/3] for vapour/liquid[/ice] water 307 ! And optionaly: iq = 3[4],nqtot for other tracers 308 !============================================================================================================================== 309 ALLOCATE(ttr(nqtot)) 310 jq = nqtrue+1; tracers(:)%iadv = -1 311 DO iq = 1, nqtrue 312 t1 => tracers(iq) 313 314 !--- VERIFY THE CHOICE OF ADVECTION SCHEME 315 iad = -1 316 IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) 317 IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 318 WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq) 319 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 320 321 !--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics 322 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 323 t1%iadv = iad 324 t1%isAdvected = iad >= 0 325 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 326 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 327 ttr(iq) = t1 328 329 !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY 330 nm = 0 331 IF(iad == 20) nm = 3 !--- 2nd order scheme 332 IF(iad == 30) nm = 9 !--- 3rd order scheme 333 IF(nm == 0) CYCLE !--- No higher moments 334 ttr(jq+1:jq+nm) = t1 335 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 336 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 337 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 338 ttr(jq+1:jq+nm)%iadv = [(-iad, im=1, nm) ] 339 ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ] 340 jq = jq + nm 341 END DO 342 DEALLOCATE(hadv, vadv) 343 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 344 345 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen 346 CALL indexUpdate(tracers) 347 348 !=== TEST ADVECTION SCHEME 349 DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv 350 351 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) 352 IF(ALL([10,14,0] /= iad)) & 353 CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1) 354 355 !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) 356 IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) & 357 CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1) 358 359 !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) 360 IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',& 361 modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10 362 363 !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 364 ll = t1%name /= addPhase('H2O','g') 365 IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', & 366 modname, iad == 14 .AND. ll)) t1%iadv = 10 367 END DO 368 369 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal" 370 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. 371 IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 372 373 !--- Convection / boundary layer activation for all tracers 374 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 375 ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 376 377 !--- Note: nqtottr can differ from nbtr when nmom/=0 378 nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz') 379 IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 380 CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1) 381 382 !=== DISPLAY THE RESULTS 383 IF(prt_level > 1) THEN 384 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 385 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 386 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 387 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 388 CALL msg('niso = '//TRIM(int2str(niso)), modname) 389 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 497 390 #ifdef INCA 498 CALL init_transport( & 499 hadv_inca, & 500 vadv_inca, & 501 conv_flg_inca, & 502 pbl_flg_inca, & 503 solsym_inca) 504 505 conv_flg(1+nqCO2:nbtr) = conv_flg_inca 506 pbl_flg(1+nqCO2:nbtr) = pbl_flg_inca 507 solsym(1+nqCO2:nbtr) = solsym_inca 508 509 IF (type_trac == 'inco') THEN 510 conv_flg(1:nqCO2) = 1 511 pbl_flg(1:nqCO2) = 1 512 solsym(1:nqCO2) = 'CO2' 513 ENDIF 514 #endif 515 516 !jyg< 517 DO iq = nqo+nqCO2+1, nqtrue 518 hadv(iq) = hadv_inca(iq-nqo-nqCO2) 519 vadv(iq) = vadv_inca(iq-nqo-nqCO2) 520 tnom_0(iq)=solsym_inca(iq-nqo-nqCO2) 521 tnom_transp(iq) = 'air' 522 END DO 523 524 ENDIF ! (type_trac == 'inca' or 'inco') 525 526 !----------------------------------------------------------------------- 527 ! 528 ! 3) Verify if advection schema 20 or 30 choosen 529 ! Calculate total number of tracers needed: nqtot 530 ! Allocate variables depending on total number of tracers 531 !----------------------------------------------------------------------- 532 new_iq=0 533 DO iq=1,nqtrue 534 ! Add tracers for certain advection schema 535 IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN 536 new_iq=new_iq+1 ! no tracers added 537 ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN 538 new_iq=new_iq+4 ! 3 tracers added 539 ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN 540 new_iq=new_iq+10 ! 9 tracers added 541 ELSE 542 WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 543 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1) 544 ENDIF 545 END DO 546 547 IF (new_iq /= nqtrue) THEN 548 ! The choice of advection schema imposes more tracers 549 ! Assigne total number of tracers 550 nqtot = new_iq 551 552 WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers' 553 WRITE(lunout,*) 'makes it necessary to add tracers' 554 WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers' 555 WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed' 556 557 ELSE 558 ! The true number of tracers is also the total number 559 nqtot = nqtrue 560 ENDIF 561 562 ! 563 ! Allocate variables with total number of tracers, nqtot 564 ! 565 ALLOCATE(tname(nqtot), ttext(nqtot)) 566 ALLOCATE(iadv(nqtot), niadv(nqtot)) 567 568 !----------------------------------------------------------------------- 569 ! 570 ! 4) Determine iadv, long and short name 571 ! 572 !----------------------------------------------------------------------- 573 new_iq=0 574 DO iq=1,nqtrue 575 new_iq=new_iq+1 576 577 ! Verify choice of advection schema 578 IF (hadv(iq)==vadv(iq)) THEN 579 iadv(new_iq)=hadv(iq) 580 ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN 581 iadv(new_iq)=11 582 ELSE 583 WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 584 585 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1) 586 ENDIF 587 588 str1=tnom_0(iq) 589 tname(new_iq)= tnom_0(iq) 590 IF (iadv(new_iq)==0) THEN 591 ttext(new_iq)=trim(str1) 592 ELSE 593 ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq)) 594 ENDIF 595 596 ! schemas tenant compte des moments d'ordre superieur 597 str2=ttext(new_iq) 598 IF (iadv(new_iq)==20) THEN 599 DO jq=1,3 600 new_iq=new_iq+1 601 iadv(new_iq)=-20 602 ttext(new_iq)=trim(str2)//txts(jq) 603 tname(new_iq)=trim(str1)//txts(jq) 604 END DO 605 ELSE IF (iadv(new_iq)==30) THEN 606 DO jq=1,9 607 new_iq=new_iq+1 608 iadv(new_iq)=-30 609 ttext(new_iq)=trim(str2)//txtp(jq) 610 tname(new_iq)=trim(str1)//txtp(jq) 611 END DO 612 ENDIF 613 END DO 614 615 ! 616 ! Find vector keeping the correspodence between true and total tracers 617 ! 618 niadv(:)=0 619 iiq=0 620 DO iq=1,nqtot 621 IF(iadv(iq).GE.0) THEN 622 ! True tracer 623 iiq=iiq+1 624 niadv(iiq)=iq 625 ENDIF 626 END DO 627 628 629 WRITE(lunout,*) trim(modname),': Information stored in infotrac :' 630 WRITE(lunout,*) trim(modname),': iadv niadv tname ttext :' 631 632 DO iq=1,nqtot 633 WRITE(lunout,*) iadv(iq),niadv(iq), ' ',trim(tname(iq)),' ',trim(ttext(iq)) 634 END DO 635 636 ! 637 ! Test for advection schema. 638 ! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) . 639 ! 640 DO iq=1,nqtot 641 IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN 642 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' 643 CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1) 644 ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN 645 WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ' 646 CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1) 647 ENDIF 648 END DO 649 650 651 ! CRisi: quels sont les traceurs fils et les traceurs peres. 652 ! initialiser tous les tableaux d'indices lies aux traceurs familiaux 653 ! + verifier que tous les peres sont ecrits en premieres positions 654 ALLOCATE(nqfils(nqtot),nqdesc(nqtot)) 655 ALLOCATE(iqfils(nqtot,nqtot)) 656 ALLOCATE(iqpere(nqtot)) 657 nqperes=0 658 nqfils(:)=0 659 nqdesc(:)=0 660 iqfils(:,:)=0 661 iqpere(:)=0 662 nqdesc_tot=0 663 DO iq=1,nqtot 664 if (tnom_transp(iq) == 'air') then 665 ! ceci est un traceur pere 666 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere' 667 nqperes=nqperes+1 668 iqpere(iq)=0 669 else !if (tnom_transp(iq) == 'air') then 670 ! ceci est un fils. Qui est son pere? 671 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils' 672 continu=.true. 673 ipere=1 674 do while (continu) 675 if (tnom_transp(iq) == tnom_0(ipere)) then 676 ! Son pere est ipere 677 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 678 & trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere)) 679 if (iq.eq.ipere) then 680 CALL abort_gcm('infotrac_init','Un fils est son propre pere',1) 681 endif 682 nqfils(ipere)=nqfils(ipere)+1 683 iqfils(nqfils(ipere),ipere)=iq 684 iqpere(iq)=ipere 685 continu=.false. 686 else !if (tnom_transp(iq) == tnom_0(ipere)) then 687 ipere=ipere+1 688 if (ipere.gt.nqtot) then 689 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 690 & trim(tnom_0(iq)),', est orphelin.' 691 CALL abort_gcm('infotrac_init','Un traceur est orphelin',1) 692 endif !if (ipere.gt.nqtot) then 693 endif !if (tnom_transp(iq) == tnom_0(ipere)) then 694 enddo !do while (continu) 695 endif !if (tnom_transp(iq) == 'air') then 696 enddo !DO iq=1,nqtot 697 WRITE(lunout,*) 'infotrac: nqperes=',nqperes 698 WRITE(lunout,*) 'nqfils=',nqfils 699 WRITE(lunout,*) 'iqpere=',iqpere 700 WRITE(lunout,*) 'iqfils=',iqfils 701 702 ! Calculer le nombre de descendants a partir de iqfils et de nbfils 703 DO iq=1,nqtot 704 generation=0 705 continu=.true. 706 ifils=iq 707 do while (continu) 708 ipere=iqpere(ifils) 709 if (ipere.gt.0) then 710 nqdesc(ipere)=nqdesc(ipere)+1 711 nqdesc_tot=nqdesc_tot+1 712 iqfils(nqdesc(ipere),ipere)=iq 713 ifils=ipere 714 generation=generation+1 715 else !if (ipere.gt.0) then 716 continu=.false. 717 endif !if (ipere.gt.0) then 718 enddo !do while (continu) 719 WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)),' est un traceur de generation: ',generation 720 enddo !DO iq=1,nqtot 721 WRITE(lunout,*) 'infotrac: nqdesc=',nqdesc 722 WRITE(lunout,*) 'iqfils=',iqfils 723 WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot 724 725 ! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas 726 ! que 10 et 14 si des peres ont des fils 727 do iq=1,nqtot 728 if (iqpere(iq).gt.0) then 729 ! ce traceur a un pere qui n'est pas l'air 730 ! Seul le schema 10 est autorise 731 if (iadv(iq)/=10) then 732 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons' 733 CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1) 734 endif 735 ! Le traceur pere ne peut etre advecte que par schema 10 ou 14: 736 IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN 737 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers' 738 CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1) 739 endif !IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN 740 endif !if (iqpere(iq).gt.0) the 741 enddo !do iq=1,nqtot 742 743 744 745 ! detecter quels sont les traceurs isotopiques parmi des traceurs 746 call infotrac_isoinit(tnom_0,nqtrue) 747 748 ! if (ntraciso.gt.0) then 749 ! le 18 sep 2020: on enleve la condition ntraciso.gt.0 car nqtottr doit etre 750 ! connu meme si il n'y a pas d'isotopes! 751 write(lunout,*) 'infotrac 702: nbtr,ntraciso=',nbtr,ntraciso 752 ! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans 753 ! phytrac 754 nbtr=nbtr-nqo*ntraciso 755 756 ! faire un tableau d'indice des traceurs qui passeront dans phytrac 757 nqtottr=nqtot-nqo*(1+ntraciso) 758 write(lunout,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo 759 ! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou new_iq /= nqtrue 760 ALLOCATE (itr_indice(nqtottr)) 761 itr_indice(:)=0 762 itr=0 763 do iq=nqo+1, nqtot 764 if (iso_num(iq).eq.0) then 765 itr=itr+1 766 write(*,*) 'itr=',itr 767 itr_indice(itr)=iq 768 endif !if (iso_num(iq).eq.0) then 769 enddo 770 if (itr.ne.nqtottr) then 771 CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1) 772 endif 773 write(lunout,*) 'itr_indice=',itr_indice 774 ! endif !if (ntraciso.gt.0) then 775 776 !----------------------------------------------------------------------- 777 ! Finalize : 778 ! 779 DEALLOCATE(tnom_0, hadv, vadv,tnom_transp) 780 781 WRITE(lunout,*) 'infotrac init fin' 782 783 END SUBROUTINE infotrac_init 784 785 SUBROUTINE infotrac_isoinit(tnom_0,nqtrue) 786 787 #ifdef CPP_IOIPSL 788 use IOIPSL 789 #else 790 ! if not using IOIPSL, we still need to use (a local version of) getin 791 use ioipsl_getincom 792 #endif 793 implicit none 794 795 ! inputs 796 INTEGER,INTENT(IN) :: nqtrue 797 CHARACTER(len=*),INTENT(IN) :: tnom_0(nqtrue) 798 799 ! locals 800 CHARACTER(len=3), DIMENSION(niso_possibles) :: tnom_iso 801 INTEGER, ALLOCATABLE,DIMENSION(:,:) :: nb_iso,nb_traciso 802 INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind 803 INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone 804 CHARACTER(len=tname_lenmax) :: tnom_trac 805 INCLUDE "iniprint.h" 806 807 tnom_iso=(/'eau','HDO','O18','O17','HTO'/) 808 809 ALLOCATE(nb_iso(niso_possibles,nqo)) 810 ALLOCATE(nb_isoind(nqo)) 811 ALLOCATE(nb_traciso(niso_possibles,nqo)) 812 ALLOCATE(iso_num(nqtot)) 813 ALLOCATE(iso_indnum(nqtot)) 814 ALLOCATE(zone_num(nqtot)) 815 ALLOCATE(phase_num(nqtot)) 816 817 iso_num(:)=0 818 iso_indnum(:)=0 819 zone_num(:)=0 820 phase_num(:)=0 821 indnum_fn_num(:)=0 822 use_iso(:)=.false. 823 nb_iso(:,:)=0 824 nb_isoind(:)=0 825 nb_traciso(:,:)=0 826 niso=0 827 ntraceurs_zone=0 828 ntraceurs_zone_prec=0 829 ntraciso=0 830 831 do iq=nqo+1,nqtot 832 ! write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq) 833 do phase=1,nqo 834 do ixt= 1,niso_possibles 835 tnom_trac=trim(tnom_0(phase))//'_' 836 tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt)) 837 ! write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac 838 IF (tnom_0(iq) == tnom_trac) then 839 ! write(lunout,*) 'Ce traceur est un isotope' 840 nb_iso(ixt,phase)=nb_iso(ixt,phase)+1 841 nb_isoind(phase)=nb_isoind(phase)+1 842 iso_num(iq)=ixt 843 iso_indnum(iq)=nb_isoind(phase) 844 indnum_fn_num(ixt)=iso_indnum(iq) 845 phase_num(iq)=phase 846 ! write(lunout,*) 'iso_num(iq)=',iso_num(iq) 847 ! write(lunout,*) 'iso_indnum(iq)=',iso_indnum(iq) 848 ! write(lunout,*) 'indnum_fn_num(ixt)=',indnum_fn_num(ixt) 849 ! write(lunout,*) 'phase_num(iq)=',phase_num(iq) 850 goto 20 851 else if (iqpere(iq).gt.0) then 852 if (tnom_0(iqpere(iq)) == tnom_trac) then 853 ! write(lunout,*) 'Ce traceur est le fils d''un isotope' 854 ! c'est un traceur d'isotope 855 nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1 856 iso_num(iq)=ixt 857 iso_indnum(iq)=indnum_fn_num(ixt) 858 zone_num(iq)=nb_traciso(ixt,phase) 859 phase_num(iq)=phase 860 ! write(lunout,*) 'iso_num(iq)=',iso_num(iq) 861 ! write(lunout,*) 'phase_num(iq)=',phase_num(iq) 862 ! write(lunout,*) 'zone_num(iq)=',zone_num(iq) 863 goto 20 864 endif !if (tnom_0(iqpere(iq)) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 865 endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 866 enddo !do ixt= niso_possibles 867 enddo !do phase=1,nqo 868 20 continue 869 enddo !do iq=1,nqtot 870 871 ! write(lunout,*) 'iso_num=',iso_num 872 ! write(lunout,*) 'iso_indnum=',iso_indnum 873 ! write(lunout,*) 'zone_num=',zone_num 874 ! write(lunout,*) 'phase_num=',phase_num 875 ! write(lunout,*) 'indnum_fn_num=',indnum_fn_num 876 877 do ixt= 1,niso_possibles 878 879 if (nb_iso(ixt,1).eq.1) then 880 ! on verifie que toutes les phases ont le meme nombre de 881 ! traceurs 882 do phase=2,nqo 883 if (nb_iso(ixt,phase).ne.nb_iso(ixt,1)) then 884 ! write(lunout,*) 'ixt,phase,nb_iso=',ixt,phase,nb_iso(ixt,phase) 885 CALL abort_gcm('infotrac_init','Phases must have same number of isotopes',1) 886 endif 887 enddo !do phase=2,nqo 888 889 niso=niso+1 890 use_iso(ixt)=.true. 891 ntraceurs_zone=nb_traciso(ixt,1) 892 893 ! on verifie que toutes les phases ont le meme nombre de 894 ! traceurs 895 do phase=2,nqo 896 if (nb_traciso(ixt,phase).ne.ntraceurs_zone) then 897 write(lunout,*) 'ixt,phase,nb_traciso=',ixt,phase,nb_traciso(ixt,phase) 898 write(lunout,*) 'ntraceurs_zone=',ntraceurs_zone 899 CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1) 900 endif 901 enddo !do phase=2,nqo 902 ! on verifie que tous les isotopes ont le meme nombre de 903 ! traceurs 904 if (ntraceurs_zone_prec.gt.0) then 905 if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 906 ntraceurs_zone_prec=ntraceurs_zone 907 else !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 908 write(*,*) 'ntraceurs_zone_prec,ntraceurs_zone=',ntraceurs_zone_prec,ntraceurs_zone 909 CALL abort_gcm('infotrac_init', & 910 &'Isotope tracers are not well defined in traceur.def',1) 911 endif !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 912 endif !if (ntraceurs_zone_prec.gt.0) then 913 914 else if (nb_iso(ixt,1).ne.0) then 915 WRITE(lunout,*) 'nqo,ixt=',nqo,ixt 916 WRITE(lunout,*) 'nb_iso(ixt,1)=',nb_iso(ixt,1) 917 CALL abort_gcm('infotrac_init','Isotopes are not well defined in traceur.def',1) 918 endif !if (nb_iso(ixt,1).eq.1) then 919 enddo ! do ixt= niso_possibles 920 921 ! dimensions isotopique: 922 ntraciso=niso*(ntraceurs_zone+1) 923 ! WRITE(lunout,*) 'niso=',niso 924 ! WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso 925 926 ! flags isotopiques: 927 if (niso.gt.0) then 928 ok_isotopes=.true. 929 else 930 ok_isotopes=.false. 931 endif 932 ! WRITE(lunout,*) 'ok_isotopes=',ok_isotopes 933 934 if (ok_isotopes) then 935 ok_iso_verif=.false. 936 call getin('ok_iso_verif',ok_iso_verif) 937 ok_init_iso=.false. 938 call getin('ok_init_iso',ok_init_iso) 939 tnat=(/1.0,155.76e-6,2005.2e-6,0.004/100.,0.0/) 940 alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/) 941 endif !if (ok_isotopes) then 942 ! WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif 943 ! WRITE(lunout,*) 'ok_init_iso=',ok_init_iso 944 945 if (ntraceurs_zone.gt.0) then 946 ok_isotrac=.true. 947 else 948 ok_isotrac=.false. 949 endif 950 ! WRITE(lunout,*) 'ok_isotrac=',ok_isotrac 951 952 ! remplissage du tableau iqiso(ntraciso,phase) 953 ALLOCATE(iqiso(ntraciso,nqo)) 954 iqiso(:,:)=0 955 do iq=1,nqtot 956 if (iso_num(iq).gt.0) then 957 ixt=iso_indnum(iq)+zone_num(iq)*niso 958 iqiso(ixt,phase_num(iq))=iq 959 endif 960 enddo 961 ! WRITE(lunout,*) 'iqiso=',iqiso 962 963 ! replissage du tableau index_trac(ntraceurs_zone,niso) 964 ALLOCATE(index_trac(ntraceurs_zone,niso)) 965 if (ok_isotrac) then 966 do iiso=1,niso 967 do izone=1,ntraceurs_zone 968 index_trac(izone,iiso)=iiso+izone*niso 969 enddo 970 enddo 971 else !if (ok_isotrac) then 972 index_trac(:,:)=0.0 973 endif !if (ok_isotrac) then 974 ! write(lunout,*) 'index_trac=',index_trac 975 976 ! Finalize : 977 DEALLOCATE(nb_iso) 978 979 END SUBROUTINE infotrac_isoinit 391 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 392 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 393 #endif 394 END IF 395 t => tracers 396 CALL msg('Information stored in infotrac :', modname) 397 IF(dispTable('isssssssssiiiiiiiii', & 398 ['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', 'isAdv ', & 399 'iadv ', 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], & 400 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), & 401 bool2str(t%isAdvected)), & 402 cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 403 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 404 CALL abort_gcm(modname, "problem with the tracers table content", 1) 405 IF(niso > 0) THEN 406 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 407 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 408 CALL msg(' isoName = '//strStack(isoName), modname) 409 CALL msg(' isoZone = '//strStack(isoZone), modname) 410 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 411 ELSE 412 CALL msg('No isotopes identified.', modname) 413 END IF 414 CALL msg('end', modname) 415 416 END SUBROUTINE init_infotrac 980 417 981 418 END MODULE infotrac -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/initdynav.F90
r2622 r4368 6 6 USE IOIPSL 7 7 #endif 8 USE infotrac, ONLY : nqtot , ttext8 USE infotrac, ONLY : nqtot 9 9 use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, & 10 10 dynhistave_file,dynhistvave_file,dynhistuave_file … … 158 158 159 159 ! DO iq=1,nqtot 160 ! call histdef(histaveid, ttext(iq), ttext(iq), '-', & 160 ! call histdef(histaveid, tracers(iq)%name, & 161 ! tracers(iq)%longName, '-', & 161 162 ! iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 162 163 ! 32, 'ave(X)', t_ops, t_wrt) -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/inithist.F
r2622 r4368 7 7 USE IOIPSL 8 8 #endif 9 USE infotrac, ONLY : nqtot , ttext9 USE infotrac, ONLY : nqtot 10 10 use com_io_dyn_mod, only : histid,histvid,histuid, & 11 11 & dynhist_file,dynhistv_file,dynhistu_file … … 157 157 ! 158 158 ! DO iq=1,nqtot 159 ! call histdef(histid, ttext(iq), ttext(iq), '-', 159 ! call histdef(histid, tracers(iq)%name, 160 ! tracers(iq)%longName, '-', 160 161 ! . iip1, jjp1, thoriid, llm, 1, llm, zvertiid, 161 162 ! . 32, 'inst(X)', t_ops, t_wrt) -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/iso_verif_dyn.F
r2270 r4368 64 64 function iso_verif_aberrant_nostop 65 65 : (x,iso,q,err_msg) 66 USE infotrac 66 USE infotrac, ONLY: isoName, getKey 67 67 implicit none 68 68 … … 74 74 ! locals 75 75 real qmin,deltaD 76 real deltaDmax,deltaDmin 76 real deltaDmax,deltaDmin,tnat 77 77 parameter (qmin=1e-11) 78 78 parameter (deltaDmax=200.0,deltaDmin=-999.9) … … 85 85 ! verifier que HDO est raisonable 86 86 if (q.gt.qmin) then 87 deltaD=(x/q/tnat(iso)-1)*1000 87 IF(getKey('tnat', tnat, isoName(iso))) THEN 88 err_msg = 'Missing isotopic parameter "tnat"' 89 iso_verif_aberrant_nostop=1 90 RETURN 91 END IF 92 deltaD=(x/q/tnat-1)*1000 88 93 if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then 89 94 write(*,*) 'erreur detectee par iso_verif_aberrant:' -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/writedynav.F90
r2622 r4368 6 6 USE ioipsl 7 7 #endif 8 USE infotrac, ONLY : nqtot , ttext8 USE infotrac, ONLY : nqtot 9 9 use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid 10 10 USE comconst_mod, ONLY: cpp … … 106 106 107 107 ! DO iq=1, nqtot 108 ! call histwrite(histaveid, t text(iq), itau_w, q(:, :, iq), &109 ! iip1*jjp1*llm, ndexu)108 ! call histwrite(histaveid, tracers(iq)%longName, itau_w, & 109 ! q(:, :, iq), iip1*jjp1*llm, ndexu) 110 110 ! enddo 111 111 -
LMDZ6/branches/Ocean_skin/libf/dyn3d_common/writehist.F
r2622 r4368 7 7 USE ioipsl 8 8 #endif 9 USE infotrac, ONLY : nqtot , ttext9 USE infotrac, ONLY : nqtot 10 10 use com_io_dyn_mod, only : histid,histvid,histuid 11 11 USE temps_mod, ONLY: itau_dyn … … 100 100 C 101 101 ! DO iq=1,nqtot 102 ! call histwrite(histid, t text(iq), itau_w, q(:,:,iq),103 ! . iip1*jjp1*llm, ndexu)102 ! call histwrite(histid, tracers(iq)%longName, itau_w, 103 ! . q(:,:,iq), iip1*jjp1*llm, ndexu) 104 104 ! enddo 105 105 !C
Note: See TracChangeset
for help on using the changeset viewer.
