Changeset 5067 for LMDZ6/trunk/libf/dyn3d
- Timestamp:
- Jul 18, 2024, 12:11:41 PM (5 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/guide_mod.F90
r4470 r5067 123 123 CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage') 124 124 ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois. 125 IF (iguide_sav .GT.0) THEN125 IF (iguide_sav>0) THEN 126 126 iguide_sav=day_step/iguide_sav 127 127 ELSE if (iguide_sav == 0) then … … 143 143 CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage') 144 144 CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert') 145 IF (iguide_int .EQ.0) THEN145 IF (iguide_int==0) THEN 146 146 iguide_int=1 147 ELSEIF (iguide_int .GT.0) THEN147 ELSEIF (iguide_int>0) THEN 148 148 iguide_int=day_step/iguide_int 149 149 ELSE … … 171 171 ! --------------------------------------------- 172 172 ncidpl=-99 173 if (guide_plevs .EQ.1) then174 if (ncidpl .eq.-99) then173 if (guide_plevs==1) then 174 if (ncidpl==-99) then 175 175 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 176 if (rcod .NE.NF90_NOERR) THEN176 if (rcod/=NF90_NOERR) THEN 177 177 abort_message=' Nudging error -> no file apbp.nc' 178 178 CALL abort_gcm(modname,abort_message,1) 179 179 endif 180 180 endif 181 elseif (guide_plevs .EQ.2) then182 if (ncidpl .EQ.-99) then181 elseif (guide_plevs==2) then 182 if (ncidpl==-99) then 183 183 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 184 if (rcod .NE.NF90_NOERR) THEN184 if (rcod/=NF90_NOERR) THEN 185 185 abort_message=' Nudging error -> no file P.nc' 186 186 CALL abort_gcm(modname,abort_message,1) … … 189 189 190 190 elseif (guide_u) then 191 if (ncidpl .eq.-99) then191 if (ncidpl==-99) then 192 192 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 193 if (rcod .NE.NF90_NOERR) THEN193 if (rcod/=NF90_NOERR) THEN 194 194 CALL abort_gcm(modname, & 195 195 ' Nudging error -> no file u.nc',1) … … 198 198 199 199 elseif (guide_v) then 200 if (ncidpl .eq.-99) then200 if (ncidpl==-99) then 201 201 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 202 if (rcod .NE.NF90_NOERR) THEN202 if (rcod/=NF90_NOERR) THEN 203 203 CALL abort_gcm(modname, & 204 204 ' Nudging error -> no file v.nc',1) … … 206 206 endif 207 207 elseif (guide_T) then 208 if (ncidpl .eq.-99) then208 if (ncidpl==-99) then 209 209 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 210 if (rcod .NE.NF90_NOERR) THEN210 if (rcod/=NF90_NOERR) THEN 211 211 CALL abort_gcm(modname, & 212 212 ' Nudging error -> no file T.nc',1) … … 214 214 endif 215 215 elseif (guide_Q) then 216 if (ncidpl .eq.-99) then216 if (ncidpl==-99) then 217 217 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 218 if (rcod .NE.NF90_NOERR) THEN218 if (rcod/=NF90_NOERR) THEN 219 219 CALL abort_gcm(modname, & 220 220 ' Nudging error -> no file hur.nc',1) … … 225 225 endif 226 226 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 227 IF (error .NE.NF90_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)228 IF (error .NE.NF90_NOERR) THEN227 IF (error/=NF90_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 228 IF (error/=NF90_NOERR) THEN 229 229 CALL abort_gcm(modname,'Nudging: error reading pressure levels',1) 230 230 ENDIF … … 306 306 ENDIF 307 307 308 IF (guide_plevs .EQ.2) THEN308 IF (guide_plevs==2) THEN 309 309 ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error) 310 310 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 314 314 ENDIF 315 315 316 IF (guide_P.OR.guide_plevs .EQ.1) THEN316 IF (guide_P.OR.guide_plevs==1) THEN 317 317 ALLOCATE(psnat1(iip1,jjp1), stat = error) 318 318 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 341 341 IF (guide_T) tnat1=tnat2 342 342 IF (guide_Q) qnat1=qnat2 343 IF (guide_plevs .EQ.2) pnat1=pnat2344 IF (guide_P.OR.guide_plevs .EQ.1) psnat1=psnat2343 IF (guide_plevs==2) pnat1=pnat2 344 IF (guide_P.OR.guide_plevs==1) psnat1=psnat2 345 345 346 346 END SUBROUTINE guide_init … … 440 440 ! Lecture des fichiers de guidage ? 441 441 !----------------------------------------------------------------------- 442 IF (iguide_read .NE.0) THEN442 IF (iguide_read/=0) THEN 443 443 ditau=real(itau) 444 444 dday_step=real(day_step) 445 IF (iguide_read .LT.0) THEN445 IF (iguide_read<0) THEN 446 446 tau=ditau/dday_step/REAL(iguide_read) 447 447 ELSE … … 449 449 ENDIF 450 450 reste=tau-AINT(tau) 451 IF (reste .EQ.0.) THEN452 IF (itau_test .EQ.itau) THEN451 IF (reste==0.) THEN 452 IF (itau_test==itau) THEN 453 453 write(lunout,*)trim(modname)//' second pass in advreel at itau=',& 454 454 itau … … 460 460 IF (guide_T) tnat1=tnat2 461 461 IF (guide_Q) qnat1=qnat2 462 IF (guide_plevs .EQ.2) pnat1=pnat2463 IF (guide_P.OR.guide_plevs .EQ.1) psnat1=psnat2462 IF (guide_plevs==2) pnat1=pnat2 463 IF (guide_P.OR.guide_plevs==1) psnat1=psnat2 464 464 step_rea=step_rea+1 465 465 itau_test=itau … … 482 482 ! Interpolation et conversion des champs de guidage 483 483 !----------------------------------------------------------------------- 484 IF (MOD(itau,iguide_int) .EQ.0) THEN484 IF (MOD(itau,iguide_int)==0) THEN 485 485 CALL guide_interp(ps,teta) 486 486 ENDIF 487 487 ! Repartition entre 2 etats de guidage 488 IF (iguide_read .NE.0) THEN488 IF (iguide_read/=0) THEN 489 489 tau=reste 490 490 ELSE … … 496 496 !----------------------------------------------------------------------- 497 497 ! Sauvegarde du guidage? 498 f_out=((MOD(itau,iguide_sav) .EQ.0).AND.guide_sav)498 f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav) 499 499 IF (f_out) THEN 500 500 ! compute pressures at layer interfaces … … 633 633 IF (guide_reg) THEN 634 634 DO i=1,iim 635 IF (lond(i) .LT.lon_min_g) imin(1)=i636 IF (lond(i) .LE.lon_max_g) imax(1)=i635 IF (lond(i)<lon_min_g) imin(1)=i 636 IF (lond(i)<=lon_max_g) imax(1)=i 637 637 ENDDO 638 638 lond=rlonv*180./pi 639 639 DO i=1,iim 640 IF (lond(i) .LT.lon_min_g) imin(2)=i641 IF (lond(i) .LE.lon_max_g) imax(2)=i640 IF (lond(i)<lon_min_g) imin(2)=i 641 IF (lond(i)<=lon_max_g) imax(2)=i 642 642 ENDDO 643 643 ENDIF … … 960 960 do j=1,pjm 961 961 do i=1,pim 962 if (typ .eq.2) then962 if (typ==2) then 963 963 zlat=rlatu(j)*180./pi 964 964 zlon=rlonu(i)*180./pi 965 elseif (typ .eq.1) then965 elseif (typ==1) then 966 966 zlat=rlatu(j)*180./pi 967 967 zlon=rlonv(i)*180./pi 968 elseif (typ .eq.3) then968 elseif (typ==3) then 969 969 zlat=rlatv(j)*180./pi 970 970 zlon=rlonv(i)*180./pi … … 1005 1005 enddo 1006 1006 enddo 1007 IF (typ .EQ.2) THEN1007 IF (typ==2) THEN 1008 1008 do j=1,jjp1 1009 1009 do i=1,iim … … 1013 1013 enddo 1014 1014 ENDIF 1015 IF (typ .EQ.3) THEN1015 IF (typ==3) THEN 1016 1016 do j=1,jjm 1017 1017 do i=1,iip1 … … 1035 1035 enddo 1036 1036 ! Calcul de gamma 1037 if (abs(grossismx-1.) .lt.0.1.or.abs(grossismy-1.).lt.0.1) then1037 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then 1038 1038 write(*,*)trim(modname)//' ATTENTION modele peu zoome' 1039 1039 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' … … 1042 1042 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1043 1043 write(*,*)trim(modname)//' gamma=',gamma 1044 if (gamma .lt.1.e-5) then1044 if (gamma<1.e-5) then 1045 1045 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1046 1046 abort_message='stopped' … … 1057 1057 do j=1,pjm 1058 1058 do i=1,pim 1059 if (typ .eq.1) then1059 if (typ==1) then 1060 1060 dxdy_=dxdys(i,j) 1061 1061 zlat=rlatu(j)*180./pi 1062 elseif (typ .eq.2) then1062 elseif (typ==2) then 1063 1063 dxdy_=dxdyu(i,j) 1064 1064 zlat=rlatu(j)*180./pi 1065 elseif (typ .eq.3) then1065 elseif (typ==3) then 1066 1066 dxdy_=dxdyv(i,j) 1067 1067 zlat=rlatv(j)*180./pi 1068 1068 endif 1069 if (abs(grossismx-1.) .lt.0.1.or.abs(grossismy-1.).lt.0.1) then1069 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then 1070 1070 ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin 1071 1071 alpha(i,j)=alphamin … … 1073 1073 xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma 1074 1074 xi=min(xi,1.) 1075 if(lat_min_g .le.zlat .and. zlat.le.lat_max_g) then1075 if(lat_min_g<=zlat .and. zlat<=lat_max_g) then 1076 1076 alpha(i,j)=xi*alphamin+(1.-xi)*alphamax 1077 1077 else … … 1118 1118 write(*,*) trim(modname)//': opening nudging files ' 1119 1119 ! Niveaux de pression si non constants 1120 if (guide_plevs .EQ.1) then1120 if (guide_plevs==1) then 1121 1121 write(*,*) trim(modname)//' Reading nudging on model levels' 1122 1122 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1123 IF (rcode .NE.NF90_NOERR) THEN1123 IF (rcode/=NF90_NOERR) THEN 1124 1124 abort_message='Nudging: error -> no file apbp.nc' 1125 1125 CALL abort_gcm(modname,abort_message,1) 1126 1126 ENDIF 1127 1127 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1128 IF (rcode .NE.NF90_NOERR) THEN1128 IF (rcode/=NF90_NOERR) THEN 1129 1129 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1130 1130 CALL abort_gcm(modname,abort_message,1) 1131 1131 ENDIF 1132 1132 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1133 IF (rcode .NE.NF90_NOERR) THEN1133 IF (rcode/=NF90_NOERR) THEN 1134 1134 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1135 1135 CALL abort_gcm(modname,abort_message,1) … … 1139 1139 1140 1140 ! Pression si guidage sur niveaux P variables 1141 if (guide_plevs .EQ.2) then1141 if (guide_plevs==2) then 1142 1142 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1143 IF (rcode .NE.NF90_NOERR) THEN1143 IF (rcode/=NF90_NOERR) THEN 1144 1144 abort_message='Nudging: error -> no file P.nc' 1145 1145 CALL abort_gcm(modname,abort_message,1) 1146 1146 ENDIF 1147 1147 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1148 IF (rcode .NE.NF90_NOERR) THEN1148 IF (rcode/=NF90_NOERR) THEN 1149 1149 abort_message='Nudging: error -> no PRES variable in file P.nc' 1150 1150 CALL abort_gcm(modname,abort_message,1) 1151 1151 ENDIF 1152 1152 write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp 1153 if (ncidpl .eq.-99) ncidpl=ncidp1153 if (ncidpl==-99) ncidpl=ncidp 1154 1154 endif 1155 1155 … … 1157 1157 if (guide_u) then 1158 1158 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1159 IF (rcode .NE.NF90_NOERR) THEN1159 IF (rcode/=NF90_NOERR) THEN 1160 1160 abort_message='Nudging: error -> no file u.nc' 1161 1161 CALL abort_gcm(modname,abort_message,1) 1162 1162 ENDIF 1163 1163 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1164 IF (rcode .NE.NF90_NOERR) THEN1164 IF (rcode/=NF90_NOERR) THEN 1165 1165 abort_message='Nudging: error -> no UWND variable in file u.nc' 1166 1166 CALL abort_gcm(modname,abort_message,1) 1167 1167 ENDIF 1168 1168 write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu 1169 if (ncidpl .eq.-99) ncidpl=ncidu1169 if (ncidpl==-99) ncidpl=ncidu 1170 1170 1171 1171 status=NF90_INQ_DIMID(ncidu, "LONU", dimid) 1172 1172 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1173 IF (lendim .NE.iip1) THEN1173 IF (lendim /= iip1) THEN 1174 1174 abort_message='dimension LONU different from iip1 in u.nc' 1175 1175 CALL abort_gcm(modname,abort_message,1) … … 1178 1178 status=NF90_INQ_DIMID(ncidu, "LATU", dimid) 1179 1179 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1180 IF (lendim .NE.jjp1) THEN1180 IF (lendim /= jjp1) THEN 1181 1181 abort_message='dimension LATU different from jjp1 in u.nc' 1182 1182 CALL abort_gcm(modname,abort_message,1) … … 1188 1188 if (guide_v) then 1189 1189 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1190 IF (rcode .NE.NF90_NOERR) THEN1190 IF (rcode/=NF90_NOERR) THEN 1191 1191 abort_message='Nudging: error -> no file v.nc' 1192 1192 CALL abort_gcm(modname,abort_message,1) 1193 1193 ENDIF 1194 1194 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1195 IF (rcode .NE.NF90_NOERR) THEN1195 IF (rcode/=NF90_NOERR) THEN 1196 1196 abort_message='Nudging: error -> no VWND variable in file v.nc' 1197 1197 CALL abort_gcm(modname,abort_message,1) 1198 1198 ENDIF 1199 1199 write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv 1200 if (ncidpl .eq.-99) ncidpl=ncidv1200 if (ncidpl==-99) ncidpl=ncidv 1201 1201 1202 1202 status=NF90_INQ_DIMID(ncidv, "LONV", dimid) 1203 1203 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1204 1204 1205 IF (lendim .NE.iip1) THEN1205 IF (lendim /= iip1) THEN 1206 1206 abort_message='dimension LONV different from iip1 in v.nc' 1207 1207 CALL abort_gcm(modname,abort_message,1) … … 1211 1211 status=NF90_INQ_DIMID(ncidv, "LATV", dimid) 1212 1212 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1213 IF (lendim .NE.jjm) THEN1213 IF (lendim /= jjm) THEN 1214 1214 abort_message='dimension LATV different from jjm in v.nc' 1215 1215 CALL abort_gcm(modname,abort_message,1) … … 1221 1221 if (guide_T) then 1222 1222 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1223 IF (rcode .NE.NF90_NOERR) THEN1223 IF (rcode/=NF90_NOERR) THEN 1224 1224 abort_message='Nudging: error -> no file T.nc' 1225 1225 CALL abort_gcm(modname,abort_message,1) 1226 1226 ENDIF 1227 1227 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1228 IF (rcode .NE.NF90_NOERR) THEN1228 IF (rcode/=NF90_NOERR) THEN 1229 1229 abort_message='Nudging: error -> no AIR variable in file T.nc' 1230 1230 CALL abort_gcm(modname,abort_message,1) 1231 1231 ENDIF 1232 1232 write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt 1233 if (ncidpl .eq.-99) ncidpl=ncidt1233 if (ncidpl==-99) ncidpl=ncidt 1234 1234 1235 1235 status=NF90_INQ_DIMID(ncidt, "LONV", dimid) 1236 1236 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1237 IF (lendim .NE.iip1) THEN1237 IF (lendim /= iip1) THEN 1238 1238 abort_message='dimension LONV different from iip1 in T.nc' 1239 1239 CALL abort_gcm(modname,abort_message,1) … … 1242 1242 status=NF90_INQ_DIMID(ncidt, "LATU", dimid) 1243 1243 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1244 IF (lendim .NE.jjp1) THEN1244 IF (lendim /= jjp1) THEN 1245 1245 abort_message='dimension LATU different from jjp1 in T.nc' 1246 1246 CALL abort_gcm(modname,abort_message,1) … … 1252 1252 if (guide_Q) then 1253 1253 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1254 IF (rcode .NE.NF90_NOERR) THEN1254 IF (rcode/=NF90_NOERR) THEN 1255 1255 abort_message='Nudging: error -> no file hur.nc' 1256 1256 CALL abort_gcm(modname,abort_message,1) 1257 1257 ENDIF 1258 1258 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1259 IF (rcode .NE.NF90_NOERR) THEN1259 IF (rcode/=NF90_NOERR) THEN 1260 1260 abort_message='Nudging: error -> no RH variable in file hur.nc' 1261 1261 CALL abort_gcm(modname,abort_message,1) 1262 1262 ENDIF 1263 1263 write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1264 if (ncidpl .eq.-99) ncidpl=ncidQ1264 if (ncidpl==-99) ncidpl=ncidQ 1265 1265 1266 1266 status=NF90_INQ_DIMID(ncidQ, "LONV", dimid) 1267 1267 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1268 IF (lendim .NE.iip1) THEN1268 IF (lendim /= iip1) THEN 1269 1269 abort_message='dimension LONV different from iip1 in hur.nc' 1270 1270 CALL abort_gcm(modname,abort_message,1) … … 1273 1273 status=NF90_INQ_DIMID(ncidQ, "LATU", dimid) 1274 1274 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1275 IF (lendim .NE.jjp1) THEN1275 IF (lendim /= jjp1) THEN 1276 1276 abort_message='dimension LATU different from jjp1 in hur.nc' 1277 1277 CALL abort_gcm(modname,abort_message,1) … … 1283 1283 if ((guide_P).OR.(guide_modele)) then 1284 1284 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1285 IF (rcode .NE.NF90_NOERR) THEN1285 IF (rcode/=NF90_NOERR) THEN 1286 1286 abort_message='Nudging: error -> no file ps.nc' 1287 1287 CALL abort_gcm(modname,abort_message,1) 1288 1288 ENDIF 1289 1289 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1290 IF (rcode .NE.NF90_NOERR) THEN1290 IF (rcode/=NF90_NOERR) THEN 1291 1291 abort_message='Nudging: error -> no SP variable in file ps.nc' 1292 1292 CALL abort_gcm(modname,abort_message,1) … … 1295 1295 endif 1296 1296 ! Coordonnee verticale 1297 if (guide_plevs .EQ.0) then1297 if (guide_plevs==0) then 1298 1298 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1299 IF (rcode .NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)1299 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1300 1300 write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1301 1301 endif 1302 1302 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1303 if (guide_plevs .EQ.1) then1303 if (guide_plevs==1) then 1304 1304 status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc]) 1305 1305 status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc]) 1306 ELSEIF (guide_plevs .EQ.0) THEN1306 ELSEIF (guide_plevs==0) THEN 1307 1307 status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc]) 1308 1308 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous … … 1329 1329 1330 1330 ! Pression 1331 if (guide_plevs .EQ.2) then1331 if (guide_plevs==2) then 1332 1332 status=NF90_GET_VAR(ncidp,varidp,pnat2,start,count) 1333 1333 IF (invert_y) THEN … … 1421 1421 write(*,*)trim(modname)//' : opening nudging files ' 1422 1422 ! Ap et Bp si niveaux de pression hybrides 1423 if (guide_plevs .EQ.1) then1423 if (guide_plevs==1) then 1424 1424 write(*,*)trim(modname)//' Reading nudging on model levels' 1425 1425 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1426 IF (rcode .NE.NF90_NOERR) THEN1426 IF (rcode/=NF90_NOERR) THEN 1427 1427 abort_message='Nudging: error -> no file apbp.nc' 1428 1428 CALL abort_gcm(modname,abort_message,1) 1429 1429 ENDIF 1430 1430 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1431 IF (rcode .NE.NF90_NOERR) THEN1431 IF (rcode/=NF90_NOERR) THEN 1432 1432 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1433 1433 CALL abort_gcm(modname,abort_message,1) 1434 1434 ENDIF 1435 1435 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1436 IF (rcode .NE.NF90_NOERR) THEN1436 IF (rcode/=NF90_NOERR) THEN 1437 1437 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1438 1438 CALL abort_gcm(modname,abort_message,1) … … 1441 1441 endif 1442 1442 ! Pression 1443 if (guide_plevs .EQ.2) then1443 if (guide_plevs==2) then 1444 1444 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1445 IF (rcode .NE.NF90_NOERR) THEN1445 IF (rcode/=NF90_NOERR) THEN 1446 1446 abort_message='Nudging: error -> no file P.nc' 1447 1447 CALL abort_gcm(modname,abort_message,1) 1448 1448 ENDIF 1449 1449 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1450 IF (rcode .NE.NF90_NOERR) THEN1450 IF (rcode/=NF90_NOERR) THEN 1451 1451 abort_message='Nudging: error -> no PRES variable in file P.nc' 1452 1452 CALL abort_gcm(modname,abort_message,1) 1453 1453 ENDIF 1454 1454 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1455 if (ncidpl .eq.-99) ncidpl=ncidp1455 if (ncidpl==-99) ncidpl=ncidp 1456 1456 endif 1457 1457 ! Vent zonal 1458 1458 if (guide_u) then 1459 1459 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1460 IF (rcode .NE.NF90_NOERR) THEN1460 IF (rcode/=NF90_NOERR) THEN 1461 1461 abort_message='Nudging: error -> no file u.nc' 1462 1462 CALL abort_gcm(modname,abort_message,1) 1463 1463 ENDIF 1464 1464 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1465 IF (rcode .NE.NF90_NOERR) THEN1465 IF (rcode/=NF90_NOERR) THEN 1466 1466 abort_message='Nudging: error -> no UWND variable in file u.nc' 1467 1467 CALL abort_gcm(modname,abort_message,1) 1468 1468 ENDIF 1469 1469 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 1470 if (ncidpl .eq.-99) ncidpl=ncidu1470 if (ncidpl==-99) ncidpl=ncidu 1471 1471 endif 1472 1472 ! Vent meridien 1473 1473 if (guide_v) then 1474 1474 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1475 IF (rcode .NE.NF90_NOERR) THEN1475 IF (rcode/=NF90_NOERR) THEN 1476 1476 abort_message='Nudging: error -> no file v.nc' 1477 1477 CALL abort_gcm(modname,abort_message,1) 1478 1478 ENDIF 1479 1479 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1480 IF (rcode .NE.NF90_NOERR) THEN1480 IF (rcode/=NF90_NOERR) THEN 1481 1481 abort_message='Nudging: error -> no VWND variable in file v.nc' 1482 1482 CALL abort_gcm(modname,abort_message,1) 1483 1483 ENDIF 1484 1484 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 1485 if (ncidpl .eq.-99) ncidpl=ncidv1485 if (ncidpl==-99) ncidpl=ncidv 1486 1486 endif 1487 1487 ! Temperature 1488 1488 if (guide_T) then 1489 1489 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1490 IF (rcode .NE.NF90_NOERR) THEN1490 IF (rcode/=NF90_NOERR) THEN 1491 1491 abort_message='Nudging: error -> no file T.nc' 1492 1492 CALL abort_gcm(modname,abort_message,1) 1493 1493 ENDIF 1494 1494 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1495 IF (rcode .NE.NF90_NOERR) THEN1495 IF (rcode/=NF90_NOERR) THEN 1496 1496 abort_message='Nudging: error -> no AIR variable in file T.nc' 1497 1497 CALL abort_gcm(modname,abort_message,1) 1498 1498 ENDIF 1499 1499 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 1500 if (ncidpl .eq.-99) ncidpl=ncidt1500 if (ncidpl==-99) ncidpl=ncidt 1501 1501 endif 1502 1502 ! Humidite 1503 1503 if (guide_Q) then 1504 1504 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1505 IF (rcode .NE.NF90_NOERR) THEN1505 IF (rcode/=NF90_NOERR) THEN 1506 1506 abort_message='Nudging: error -> no file hur.nc' 1507 1507 CALL abort_gcm(modname,abort_message,1) 1508 1508 ENDIF 1509 1509 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1510 IF (rcode .NE.NF90_NOERR) THEN1510 IF (rcode/=NF90_NOERR) THEN 1511 1511 abort_message='Nudging: error -> no RH,variable in file hur.nc' 1512 1512 CALL abort_gcm(modname,abort_message,1) 1513 1513 ENDIF 1514 1514 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1515 if (ncidpl .eq.-99) ncidpl=ncidQ1515 if (ncidpl==-99) ncidpl=ncidQ 1516 1516 endif 1517 1517 ! Pression de surface 1518 1518 if ((guide_P).OR.(guide_modele)) then 1519 1519 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1520 IF (rcode .NE.NF90_NOERR) THEN1520 IF (rcode/=NF90_NOERR) THEN 1521 1521 abort_message='Nudging: error -> no file ps.nc' 1522 1522 CALL abort_gcm(modname,abort_message,1) 1523 1523 ENDIF 1524 1524 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1525 IF (rcode .NE.NF90_NOERR) THEN1525 IF (rcode/=NF90_NOERR) THEN 1526 1526 abort_message='Nudging: error -> no SP variable in file ps.nc' 1527 1527 CALL abort_gcm(modname,abort_message,1) … … 1530 1530 endif 1531 1531 ! Coordonnee verticale 1532 if (guide_plevs .EQ.0) then1532 if (guide_plevs==0) then 1533 1533 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1534 IF (rcode .NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)1534 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1535 1535 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1536 1536 endif 1537 1537 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1538 if (guide_plevs .EQ.1) then1538 if (guide_plevs==1) then 1539 1539 status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc]) 1540 1540 status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc]) 1541 elseif (guide_plevs .EQ.0) THEN1541 elseif (guide_plevs==0) THEN 1542 1542 status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc]) 1543 1543 apnc=apnc*100.! conversion en Pascals … … 1563 1563 1564 1564 ! Pression 1565 if (guide_plevs .EQ.2) then1565 if (guide_plevs==2) then 1566 1566 status=NF90_GET_VAR(ncidp,varidp,zu,start,count) 1567 1567 DO i=1,iip1 … … 1629 1629 1630 1630 ! Pression de surface 1631 if ((guide_P).OR.(guide_plevs .EQ.1)) then1631 if ((guide_P).OR.(guide_plevs==1)) then 1632 1632 start(3)=timestep 1633 1633 start(4)=0 … … 1681 1681 1682 1682 write(*,*)trim(modname)//': output timestep',timestep,'var ',varname 1683 IF (timestep .EQ.0) THEN1683 IF (timestep==0) THEN 1684 1684 ! ---------------------------------------------- 1685 1685 ! initialisation fichier de sortie … … 1828 1828 do l=1,nl 1829 1829 do i=2,iim-1 1830 if(abs(x(i,l)) .gt.1.e10) then1830 if(abs(x(i,l))>1.e10) then 1831 1831 zz=0.5*(x(i-1,l)+x(i+1,l)) 1832 1832 print*,'correction ',i,l,x(i,l),zz
Note: See TracChangeset
for help on using the changeset viewer.