Changeset 3995 for LMDZ6/trunk/libf
- Timestamp:
- Oct 29, 2021, 5:38:11 PM (3 years ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/guide_mod.F90
r3803 r3995 9 9 !======================================================================= 10 10 11 USE getparam 11 USE getparam, only: ini_getparam, fin_getparam, getpar 12 12 USE Write_Field 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close 14 use pres2lev_mod 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, & 14 nf90_inq_dimid, nf90_inquire_dimension 15 use pres2lev_mod, only: pres2lev 15 16 16 17 IMPLICIT NONE … … 20 21 ! --------------------------------------------- 21 22 INTEGER, PRIVATE, SAVE :: iguide_read,iguide_int,iguide_sav 22 INTEGER, PRIVATE, SAVE :: nlevnc 23 INTEGER, PRIVATE, SAVE :: nlevnc, guide_plevs 23 24 LOGICAL, PRIVATE, SAVE :: guide_u,guide_v,guide_T,guide_Q,guide_P 24 25 LOGICAL, PRIVATE, SAVE :: guide_hr,guide_teta 25 26 LOGICAL, PRIVATE, SAVE :: guide_BL,guide_reg,guide_add,gamma4,guide_zon 26 LOGICAL, PRIVATE, SAVE :: guide_modele,invert_p,invert_y,ini_anal 27 LOGICAL, PRIVATE, SAVE :: guide_2D,guide_sav 27 LOGICAL, PRIVATE, SAVE :: invert_p,invert_y,ini_anal 28 LOGICAL, PRIVATE, SAVE :: guide_2D,guide_sav,guide_modele 29 !FC 30 LOGICAL, PRIVATE, SAVE :: convert_Pa 28 31 29 32 REAL, PRIVATE, SAVE :: tau_min_u,tau_max_u … … 49 52 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: tnat1,tnat2 50 53 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: qnat1,qnat2 54 REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: pnat1,pnat2 51 55 REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: psnat1,psnat2 52 56 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: apnc,bpnc … … 75 79 CHARACTER (len = 80) :: abort_message 76 80 CHARACTER (len = 20) :: modname = 'guide_init' 81 CHARACTER (len = 20) :: namedim 77 82 78 83 ! --------------------------------------------- … … 140 145 iguide_int=day_step*iguide_int 141 146 ENDIF 142 CALL getpar('guide_modele',.false.,guide_modele,'guidage niveaux modele') 147 CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage') 148 ! Pour compatibilite avec ancienne version avec guide_modele 149 CALL getpar('guide_modele',.false.,guide_modele,'niveaux pression ap+bp*psol') 150 IF (guide_modele) THEN 151 guide_plevs=1 152 ENDIF 153 !FC 154 CALL getpar('convert_Pa',.true.,convert_Pa,'Convert Pressure levels in Pa') 155 ! Fin raccord 143 156 CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse') 144 157 CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses') … … 153 166 ! --------------------------------------------- 154 167 ncidpl=-99 155 if (guide_ modele) then168 if (guide_plevs.EQ.1) then 156 169 if (ncidpl.eq.-99) then 157 170 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 158 171 if (rcod.NE.NF_NOERR) THEN 159 CALL abort_gcm(modname, &160 'Guide: probleme -> pas de fichier apbp.nc',1)172 abort_message=' Nudging error -> no file apbp.nc' 173 CALL abort_gcm(modname,abort_message,1) 161 174 endif 162 175 endif 163 else 164 if (guide_u) then 176 elseif (guide_plevs.EQ.2) then 177 if (ncidpl.EQ.-99) then 178 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 179 if (rcod.NE.NF_NOERR) THEN 180 abort_message=' Nudging error -> no file P.nc' 181 CALL abort_gcm(modname,abort_message,1) 182 endif 183 endif 184 185 elseif (guide_u) then 165 186 if (ncidpl.eq.-99) then 166 187 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 167 188 if (rcod.NE.NF_NOERR) THEN 168 189 CALL abort_gcm(modname, & 169 ' Guide: probleme -> pas de fichieru.nc',1)190 ' Nudging error -> no file u.nc',1) 170 191 endif 171 192 endif 172 elseif (guide_v) then 193 194 elseif (guide_v) then 173 195 if (ncidpl.eq.-99) then 174 196 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 175 197 if (rcod.NE.NF_NOERR) THEN 176 198 CALL abort_gcm(modname, & 177 ' Guide: probleme -> pas de fichierv.nc',1)199 ' Nudging error -> no file v.nc',1) 178 200 endif 179 201 endif 180 202 elseif (guide_T) then 181 203 if (ncidpl.eq.-99) then 182 204 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 183 205 if (rcod.NE.NF_NOERR) THEN 184 206 CALL abort_gcm(modname, & 185 ' Guide: probleme -> pas de fichierT.nc',1)207 ' Nudging error -> no file T.nc',1) 186 208 endif 187 209 endif 188 210 elseif (guide_Q) then 189 211 if (ncidpl.eq.-99) then 190 212 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 191 213 if (rcod.NE.NF_NOERR) THEN 192 214 CALL abort_gcm(modname, & 193 ' Guide: probleme -> pas de fichierhur.nc',1)215 ' Nudging error -> no file hur.nc',1) 194 216 endif 195 217 endif 196 endif 218 219 197 220 endif 198 221 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 199 222 IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 200 223 IF (error.NE.NF_NOERR) THEN 201 CALL abort_gcm(modname,' Guide: probleme lecture niveaux pression',1)224 CALL abort_gcm(modname,'Nudging: error reading pressure levels',1) 202 225 ENDIF 203 226 error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc) 204 print *,'Guide: nombre niveaux vert.nlevnc', nlevnc227 write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc 205 228 rcod = nf90_close(ncidpl) 206 229 … … 208 231 ! Allocation des variables 209 232 ! --------------------------------------------- 210 abort_message=' pb in allocation guide'233 abort_message='nudging allocation error' 211 234 212 235 ALLOCATE(apnc(nlevnc), stat = error) … … 278 301 ENDIF 279 302 280 IF (guide_P.OR.guide_modele) THEN 303 IF (guide_plevs.EQ.2) THEN 304 ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error) 305 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) 306 ALLOCATE(pnat2(iip1,jjp1,nlevnc), stat = error) 307 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) 308 pnat1=0.;pnat2=0.; 309 ENDIF 310 311 IF (guide_P.OR.guide_plevs.EQ.1) THEN 281 312 ALLOCATE(psnat1(iip1,jjp1), stat = error) 282 313 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 305 336 IF (guide_T) tnat1=tnat2 306 337 IF (guide_Q) qnat1=qnat2 307 IF (guide_P.OR.guide_modele) psnat1=psnat2 338 IF (guide_plevs.EQ.2) pnat1=pnat2 339 IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2 308 340 309 341 END SUBROUTINE guide_init … … 312 344 SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps) 313 345 346 USE exner_hyb_m, ONLY: exner_hyb 347 USE exner_milieu_m, ONLY: exner_milieu 314 348 USE control_mod, ONLY: day_step, iperiod 315 USE comconst_mod, ONLY: dtvr, daysec316 USE comvert_mod, ONLY: ap, bp, preff, presnivs 349 USE comconst_mod, ONLY: cpp, dtvr, daysec,kappa 350 USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner 317 351 318 352 IMPLICIT NONE … … 331 365 LOGICAL :: f_out ! sortie guidage 332 366 REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage 333 REAL, DIMENSION (ip1jmp1,llm) :: p ! besoin si guide_P 367 REAL :: pk(ip1jmp1,llm) ! Exner at mid-layers 368 REAL :: pks(ip1jmp1) ! Exner at the surface 369 REAL :: unskap ! 1./kappa 370 REAL, DIMENSION (ip1jmp1,llmp1) :: p ! Pressure at inter-layers 334 371 ! Compteurs temps: 335 372 INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage … … 339 376 340 377 INTEGER :: l 378 CHARACTER(LEN=20) :: modname="guide_main" 341 379 342 380 !----------------------------------------------------------------------- … … 379 417 ENDIF 380 418 ! Verification structure guidage 381 IF (guide_u) THEN382 CALL writefield('unat',unat1)383 CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))384 ENDIF385 IF (guide_T) THEN386 CALL writefield('tnat',tnat1)387 CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))388 ENDIF419 ! IF (guide_u) THEN 420 ! CALL writefield('unat',unat1) 421 ! CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/))) 422 ! ENDIF 423 ! IF (guide_T) THEN 424 ! CALL writefield('tnat',tnat1) 425 ! CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/))) 426 ! ENDIF 389 427 390 428 ENDIF !first … … 404 442 IF (reste.EQ.0.) THEN 405 443 IF (itau_test.EQ.itau) THEN 406 write(*,*)'deuxieme passage de advreel a itau=',itau 407 stop 444 write(*,*)trim(modname)//' second pass in advreel at itau=',& 445 itau 446 stop 408 447 ELSE 409 448 IF (guide_v) vnat1=vnat2 … … 411 450 IF (guide_T) tnat1=tnat2 412 451 IF (guide_Q) qnat1=qnat2 413 IF (guide_P.OR.guide_modele) psnat1=psnat2 452 IF (guide_plevs.EQ.2) pnat1=pnat2 453 IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2 414 454 step_rea=step_rea+1 415 455 itau_test=itau 416 print*,'Lecture fichiers guidage, pas ',step_rea,&417 'apres ',count_no_rea,' non lectures'456 write(*,*)trim(modname)//' Reading nudging files, step ',& 457 step_rea,'after ',count_no_rea,' skips' 418 458 IF (guide_2D) THEN 419 459 CALL guide_read2D(step_rea) … … 447 487 ! Sauvegarde du guidage? 448 488 f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 449 IF (f_out) CALL guide_out("SP",jjp1,1,ps) 489 IF (f_out) THEN 490 ! compute pressures at layer interfaces 491 CALL pression(ip1jmp1,ap,bp,ps,p) 492 if (pressure_exner) then 493 call exner_hyb(ip1jmp1,ps,p,pks,pk) 494 else 495 call exner_milieu(ip1jmp1,ps,p,pks,pk) 496 endif 497 unskap=1./kappa 498 ! Now compute pressures at mid-layer 499 do l=1,llm 500 p(:,l)=preff*(pk(:,l)/cpp)**unskap 501 enddo 502 CALL guide_out("SP",jjp1,llm,p(:,1:llm)) 503 ENDIF 450 504 451 505 if (guide_u) then … … 483 537 if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1)) 484 538 CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P) 485 IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)539 ! IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt) 486 540 ps=ps+f_add(1:ip1jmp1,1) 487 541 CALL pression(ip1jmp1,ap,bp,ps,p) … … 637 691 638 692 INTEGER :: i,j,l,ij 693 CHARACTER(LEN=20),PARAMETER :: modname="guide_interp" 639 694 640 print *,'Guide: conversion variables guidage'695 write(*,*)trim(modname)//': interpolate nudging variables' 641 696 ! ----------------------------------------------------------------- 642 697 ! Calcul des niveaux de pression champs guidage … … 664 719 if (first) then 665 720 first=.FALSE. 666 print*,'Guide: verification ordre niveaux verticaux'667 print*,'LMDZ :'721 write(*,*)trim(modname)//' : check vertical level order' 722 write(*,*)trim(modname)//' LMDZ :' 668 723 do l=1,llm 669 print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &724 write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. & 670 725 +psi(1,jjp1)*(bp(l)+bp(l+1))/2. 671 726 enddo 672 print*,'Fichiers guidage'727 write(*,*)trim(modname)//' nudging file :' 673 728 do l=1,nlevnc 674 print*,'PL(',l,')=',plnc2(1,1,l)729 write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l) 675 730 enddo 676 print *,'inversion de l''ordre: invert_p=',invert_p731 write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p 677 732 if (guide_u) then 678 733 do l=1,nlevnc 679 print*,'U(',l,')=',unat2(1,1,l)734 write(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l) 680 735 enddo 681 736 endif 682 737 if (guide_T) then 683 738 do l=1,nlevnc 684 print*,'T(',l,')=',tnat2(1,1,l)739 write(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l) 685 740 enddo 686 741 endif … … 881 936 real alphamin,alphamax,xi 882 937 integer i,j,ilon,ilat 938 character(len=20),parameter :: modname="tau2alpha" 883 939 884 940 … … 969 1025 ! Calcul de gamma 970 1026 if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then 971 print*,'ATTENTION modele peu zoome'972 print*,'ATTENTION on prend une constante de guidage cste'973 1027 write(*,*)trim(modname)//' ATTENTION modele peu zoome' 1028 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' 1029 gamma=0. 974 1030 else 975 976 print*,'gamma=',gamma977 978 print*,'gamma =',gamma,'<1e-5'979 980 981 982 983 984 985 print*,'gamma=',gamma1031 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1032 write(*,*)trim(modname)//' gamma=',gamma 1033 if (gamma.lt.1.e-5) then 1034 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1035 stop 1036 endif 1037 gamma=log(0.5)/log(gamma) 1038 if (gamma4) then 1039 gamma=min(gamma,4.) 1040 endif 1041 write(*,*)trim(modname)//' gamma=',gamma 986 1042 endif 987 1043 ENDIF !first … … 1024 1080 IMPLICIT NONE 1025 1081 1026 #include "netcdf.inc"1027 #include "dimensions.h"1028 #include "paramet.h"1082 include "netcdf.inc" 1083 include "dimensions.h" 1084 include "paramet.h" 1029 1085 1030 1086 INTEGER, INTENT(IN) :: timestep … … 1032 1088 LOGICAL, SAVE :: first=.TRUE. 1033 1089 ! Identification fichiers et variables NetCDF: 1034 INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncid Q1035 INTEGER, SAVE :: varidQ,ncidt,varidt,ncidps,varidps1036 INTEGER :: ncidpl,varidpl,varidap,varidbp 1090 INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncidp,varidp 1091 INTEGER, SAVE :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps 1092 INTEGER :: ncidpl,varidpl,varidap,varidbp,dimid,lendim 1037 1093 ! Variables auxiliaires NetCDF: 1038 1094 INTEGER, DIMENSION(4) :: start,count 1039 1095 INTEGER :: status,rcode 1040 1041 1096 CHARACTER (len = 80) :: abort_message 1042 1097 CHARACTER (len = 20) :: modname = 'guide_read' 1098 CHARACTER (len = 20) :: namedim 1099 1043 1100 ! ----------------------------------------------------------------- 1044 1101 ! Premier appel: initialisation de la lecture des fichiers … … 1046 1103 if (first) then 1047 1104 ncidpl=-99 1048 print*,'Guide: ouverture des fichiers guidage'1105 write(*,*),trim(modname)//': opening nudging files ' 1049 1106 ! Niveaux de pression si non constants 1050 if (guide_ modele) then1051 print *,'Lecture du guidage sur niveaux modele'1107 if (guide_plevs.EQ.1) then 1108 write(*,*),trim(modname)//' Reading nudging on model levels' 1052 1109 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1053 1110 IF (rcode.NE.NF_NOERR) THEN 1054 print *,'Guide: probleme -> pas de fichierapbp.nc'1111 abort_message='Nudging: error -> no file apbp.nc' 1055 1112 CALL abort_gcm(modname,abort_message,1) 1056 1113 ENDIF 1057 1114 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1058 1115 IF (rcode.NE.NF_NOERR) THEN 1059 print *,'Guide: probleme -> pas de variable AP, fichierapbp.nc'1116 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1060 1117 CALL abort_gcm(modname,abort_message,1) 1061 1118 ENDIF 1062 1119 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1063 1120 IF (rcode.NE.NF_NOERR) THEN 1064 print *,'Guide: probleme -> pas de variable BP, fichierapbp.nc'1121 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1065 1122 CALL abort_gcm(modname,abort_message,1) 1066 1123 ENDIF 1067 print*,'ncidpl,varidap',ncidpl,varidap1124 write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap 1068 1125 endif 1126 1127 ! Pression si guidage sur niveaux P variables 1128 if (guide_plevs.EQ.2) then 1129 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1130 IF (rcode.NE.NF_NOERR) THEN 1131 abort_message='Nudging: error -> no file P.nc' 1132 CALL abort_gcm(modname,abort_message,1) 1133 ENDIF 1134 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1135 IF (rcode.NE.NF_NOERR) THEN 1136 abort_message='Nudging: error -> no PRES variable in file P.nc' 1137 CALL abort_gcm(modname,abort_message,1) 1138 ENDIF 1139 write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp 1140 if (ncidpl.eq.-99) ncidpl=ncidp 1141 endif 1142 1069 1143 ! Vent zonal 1070 1144 if (guide_u) then 1071 1145 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1072 1146 IF (rcode.NE.NF_NOERR) THEN 1073 print *,'Guide: probleme -> pas de fichieru.nc'1147 abort_message='Nudging: error -> no file u.nc' 1074 1148 CALL abort_gcm(modname,abort_message,1) 1075 1149 ENDIF 1076 1150 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1077 1151 IF (rcode.NE.NF_NOERR) THEN 1078 print *,'Guide: probleme -> pas de variable UWND, fichieru.nc'1152 abort_message='Nudging: error -> no UWND variable in file u.nc' 1079 1153 CALL abort_gcm(modname,abort_message,1) 1080 1154 ENDIF 1081 print*,'ncidu,varidu',ncidu,varidu1155 write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu 1082 1156 if (ncidpl.eq.-99) ncidpl=ncidu 1157 1158 status=NF90_INQ_DIMID(ncidu, "LONU", dimid) 1159 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1160 IF (lendim .NE. iip1) THEN 1161 abort_message='dimension LONU different from iip1 in u.nc' 1162 CALL abort_gcm(modname,abort_message,1) 1163 ENDIF 1164 1165 status=NF90_INQ_DIMID(ncidu, "LATU", dimid) 1166 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1167 IF (lendim .NE. jjp1) THEN 1168 abort_message='dimension LATU different from jjp1 in u.nc' 1169 CALL abort_gcm(modname,abort_message,1) 1170 ENDIF 1171 1083 1172 endif 1173 1084 1174 ! Vent meridien 1085 1175 if (guide_v) then 1086 1176 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1087 1177 IF (rcode.NE.NF_NOERR) THEN 1088 print *,'Guide: probleme -> pas de fichierv.nc'1178 abort_message='Nudging: error -> no file v.nc' 1089 1179 CALL abort_gcm(modname,abort_message,1) 1090 1180 ENDIF 1091 1181 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1092 1182 IF (rcode.NE.NF_NOERR) THEN 1093 print *,'Guide: probleme -> pas de variable VWND, fichierv.nc'1183 abort_message='Nudging: error -> no VWND variable in file v.nc' 1094 1184 CALL abort_gcm(modname,abort_message,1) 1095 1185 ENDIF 1096 print*,'ncidv,varidv',ncidv,varidv1186 write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv 1097 1187 if (ncidpl.eq.-99) ncidpl=ncidv 1188 1189 status=NF90_INQ_DIMID(ncidv, "LONV", dimid) 1190 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1191 1192 IF (lendim .NE. iip1) THEN 1193 abort_message='dimension LONV different from iip1 in v.nc' 1194 CALL abort_gcm(modname,abort_message,1) 1195 ENDIF 1196 1197 1198 status=NF90_INQ_DIMID(ncidv, "LATV", dimid) 1199 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1200 IF (lendim .NE. jjm) THEN 1201 abort_message='dimension LATV different from jjm in v.nc' 1202 CALL abort_gcm(modname,abort_message,1) 1203 ENDIF 1204 1098 1205 endif 1206 1099 1207 ! Temperature 1100 1208 if (guide_T) then 1101 1209 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1102 1210 IF (rcode.NE.NF_NOERR) THEN 1103 print *,'Guide: probleme -> pas de fichierT.nc'1211 abort_message='Nudging: error -> no file T.nc' 1104 1212 CALL abort_gcm(modname,abort_message,1) 1105 1213 ENDIF 1106 1214 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1107 1215 IF (rcode.NE.NF_NOERR) THEN 1108 print *,'Guide: probleme -> pas de variable AIR, fichierT.nc'1216 abort_message='Nudging: error -> no AIR variable in file T.nc' 1109 1217 CALL abort_gcm(modname,abort_message,1) 1110 1218 ENDIF 1111 print*,'ncidT,varidT',ncidt,varidt1219 write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt 1112 1220 if (ncidpl.eq.-99) ncidpl=ncidt 1221 1222 status=NF90_INQ_DIMID(ncidt, "LONV", dimid) 1223 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1224 IF (lendim .NE. iip1) THEN 1225 abort_message='dimension LONV different from iip1 in T.nc' 1226 CALL abort_gcm(modname,abort_message,1) 1227 ENDIF 1228 1229 status=NF90_INQ_DIMID(ncidt, "LATU", dimid) 1230 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1231 IF (lendim .NE. jjp1) THEN 1232 abort_message='dimension LATU different from jjp1 in T.nc' 1233 CALL abort_gcm(modname,abort_message,1) 1234 ENDIF 1235 1113 1236 endif 1237 1114 1238 ! Humidite 1115 1239 if (guide_Q) then 1116 1240 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1117 1241 IF (rcode.NE.NF_NOERR) THEN 1118 print *,'Guide: probleme -> pas de fichierhur.nc'1242 abort_message='Nudging: error -> no file hur.nc' 1119 1243 CALL abort_gcm(modname,abort_message,1) 1120 1244 ENDIF 1121 1245 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1122 1246 IF (rcode.NE.NF_NOERR) THEN 1123 print *,'Guide: probleme -> pas de variable RH, fichierhur.nc'1247 abort_message='Nudging: error -> no RH variable in file hur.nc' 1124 1248 CALL abort_gcm(modname,abort_message,1) 1125 1249 ENDIF 1126 print*,'ncidQ,varidQ',ncidQ,varidQ1250 write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1127 1251 if (ncidpl.eq.-99) ncidpl=ncidQ 1252 1253 status=NF90_INQ_DIMID(ncidQ, "LONV", dimid) 1254 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1255 IF (lendim .NE. iip1) THEN 1256 abort_message='dimension LONV different from iip1 in hur.nc' 1257 CALL abort_gcm(modname,abort_message,1) 1258 ENDIF 1259 1260 status=NF90_INQ_DIMID(ncidQ, "LATU", dimid) 1261 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1262 IF (lendim .NE. jjp1) THEN 1263 abort_message='dimension LATU different from jjp1 in hur.nc' 1264 CALL abort_gcm(modname,abort_message,1) 1265 ENDIF 1266 1128 1267 endif 1268 1129 1269 ! Pression de surface 1130 1270 if ((guide_P).OR.(guide_modele)) then 1131 1271 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1132 1272 IF (rcode.NE.NF_NOERR) THEN 1133 print *,'Guide: probleme -> pas de fichierps.nc'1273 abort_message='Nudging: error -> no file ps.nc' 1134 1274 CALL abort_gcm(modname,abort_message,1) 1135 1275 ENDIF 1136 1276 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1137 1277 IF (rcode.NE.NF_NOERR) THEN 1138 print *,'Guide: probleme -> pas de variable SP, fichierps.nc'1278 abort_message='Nudging: error -> no SP variable in file ps.nc' 1139 1279 CALL abort_gcm(modname,abort_message,1) 1140 1280 ENDIF 1141 print*,'ncidps,varidps',ncidps,varidps1281 write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps 1142 1282 endif 1143 1283 ! Coordonnee verticale 1144 if ( .not.guide_modele) then1284 if (guide_plevs.EQ.0) then 1145 1285 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1146 1286 IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1147 print*,'ncidpl,varidpl',ncidpl,varidpl1287 write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1148 1288 endif 1149 1289 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1150 if (guide_ modele) then1290 if (guide_plevs.EQ.1) then 1151 1291 #ifdef NC_DOUBLE 1152 1292 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) … … 1156 1296 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 1157 1297 #endif 1158 else1298 ELSEIF (guide_plevs.EQ.0) THEN 1159 1299 #ifdef NC_DOUBLE 1160 1300 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) … … 1162 1302 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc) 1163 1303 #endif 1164 apnc=apnc*100.! conversion en Pascals 1304 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous 1305 IF(convert_Pa) apnc=apnc*100.! conversion en Pascals 1165 1306 bpnc(:)=0. 1166 1307 endif … … 1182 1323 count(3)=nlevnc 1183 1324 count(4)=1 1325 1326 ! Pression 1327 if (guide_plevs.EQ.2) then 1328 #ifdef NC_DOUBLE 1329 status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2) 1330 #else 1331 status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2) 1332 #endif 1333 IF (invert_y) THEN 1334 ! PRINT*,"Invertion impossible actuellement" 1335 ! CALL abort_gcm(modname,abort_message,1) 1336 CALL invert_lat(iip1,jjp1,nlevnc,pnat2) 1337 ENDIF 1338 endif 1184 1339 1185 1340 ! Vent zonal … … 1257 1412 IMPLICIT NONE 1258 1413 1259 #include "netcdf.inc"1260 #include "dimensions.h"1261 #include "paramet.h"1414 include "netcdf.inc" 1415 include "dimensions.h" 1416 include "paramet.h" 1262 1417 1263 1418 INTEGER, INTENT(IN) :: timestep … … 1265 1420 LOGICAL, SAVE :: first=.TRUE. 1266 1421 ! Identification fichiers et variables NetCDF: 1267 INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncid Q1268 INTEGER, SAVE :: varidQ,ncidt,varidt,ncidps,varidps1422 INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncidp,varidp 1423 INTEGER, SAVE :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps 1269 1424 INTEGER :: ncidpl,varidpl,varidap,varidbp 1270 1425 ! Variables auxiliaires NetCDF: … … 1283 1438 if (first) then 1284 1439 ncidpl=-99 1285 print*,'Guide: ouverture des fichiers guidage ' 1286 ! Niveaux de pression si non constants 1287 if (guide_modele) then 1288 print *,'Lecture du guidage sur niveaux modele' 1289 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1290 IF (rcode.NE.NF_NOERR) THEN 1291 print *,'Guide: probleme -> pas de fichier apbp.nc' 1292 CALL abort_gcm(modname,abort_message,1) 1293 ENDIF 1294 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1295 IF (rcode.NE.NF_NOERR) THEN 1296 print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc' 1297 CALL abort_gcm(modname,abort_message,1) 1298 ENDIF 1299 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1300 IF (rcode.NE.NF_NOERR) THEN 1301 print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc' 1302 CALL abort_gcm(modname,abort_message,1) 1303 ENDIF 1304 print*,'ncidpl,varidap',ncidpl,varidap 1440 write(*,*)trim(modname)//' : opening nudging files ' 1441 ! Ap et Bp si niveaux de pression hybrides 1442 if (guide_plevs.EQ.1) then 1443 write(*,*)trim(modname)//' Reading nudging on model levels' 1444 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1445 IF (rcode.NE.NF_NOERR) THEN 1446 abort_message='Nudging: error -> no file apbp.nc' 1447 CALL abort_gcm(modname,abort_message,1) 1448 ENDIF 1449 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1450 IF (rcode.NE.NF_NOERR) THEN 1451 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1452 CALL abort_gcm(modname,abort_message,1) 1453 ENDIF 1454 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1455 IF (rcode.NE.NF_NOERR) THEN 1456 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1457 CALL abort_gcm(modname,abort_message,1) 1458 ENDIF 1459 write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap 1460 endif 1461 ! Pression 1462 if (guide_plevs.EQ.2) then 1463 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1464 IF (rcode.NE.NF_NOERR) THEN 1465 abort_message='Nudging: error -> no file P.nc' 1466 CALL abort_gcm(modname,abort_message,1) 1467 ENDIF 1468 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1469 IF (rcode.NE.NF_NOERR) THEN 1470 abort_message='Nudging: error -> no PRES variable in file P.nc' 1471 CALL abort_gcm(modname,abort_message,1) 1472 ENDIF 1473 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1474 if (ncidpl.eq.-99) ncidpl=ncidp 1305 1475 endif 1306 1476 ! Vent zonal 1307 1477 if (guide_u) then 1308 1309 1310 print *,'Guide: probleme -> pas de fichieru.nc'1311 1312 1313 1314 1315 print *,'Guide: probleme -> pas de variable UWND, fichieru.nc'1316 1317 1318 print*,'ncidu,varidu',ncidu,varidu1319 1478 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1479 IF (rcode.NE.NF_NOERR) THEN 1480 abort_message='Nudging: error -> no file u.nc' 1481 CALL abort_gcm(modname,abort_message,1) 1482 ENDIF 1483 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1484 IF (rcode.NE.NF_NOERR) THEN 1485 abort_message='Nudging: error -> no UWND variable in file u.nc' 1486 CALL abort_gcm(modname,abort_message,1) 1487 ENDIF 1488 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 1489 if (ncidpl.eq.-99) ncidpl=ncidu 1320 1490 endif 1321 1491 ! Vent meridien 1322 1492 if (guide_v) then 1323 1324 1325 print *,'Guide: probleme -> pas de fichierv.nc'1326 1327 1328 1329 1330 print *,'Guide: probleme -> pas de variable VWND, fichierv.nc'1331 1332 1333 print*,'ncidv,varidv',ncidv,varidv1334 1493 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1494 IF (rcode.NE.NF_NOERR) THEN 1495 abort_message='Nudging: error -> no file v.nc' 1496 CALL abort_gcm(modname,abort_message,1) 1497 ENDIF 1498 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1499 IF (rcode.NE.NF_NOERR) THEN 1500 abort_message='Nudging: error -> no VWND variable in file v.nc' 1501 CALL abort_gcm(modname,abort_message,1) 1502 ENDIF 1503 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 1504 if (ncidpl.eq.-99) ncidpl=ncidv 1335 1505 endif 1336 1506 ! Temperature 1337 1507 if (guide_T) then 1338 1339 1340 print *,'Guide: probleme -> pas de fichierT.nc'1341 1342 1343 1344 1345 print *,'Guide: probleme -> pas de variable AIR, fichierT.nc'1346 1347 1348 print*,'ncidT,varidT',ncidt,varidt1349 1508 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1509 IF (rcode.NE.NF_NOERR) THEN 1510 abort_message='Nudging: error -> no file T.nc' 1511 CALL abort_gcm(modname,abort_message,1) 1512 ENDIF 1513 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1514 IF (rcode.NE.NF_NOERR) THEN 1515 abort_message='Nudging: error -> no AIR variable in file T.nc' 1516 CALL abort_gcm(modname,abort_message,1) 1517 ENDIF 1518 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 1519 if (ncidpl.eq.-99) ncidpl=ncidt 1350 1520 endif 1351 1521 ! Humidite 1352 1522 if (guide_Q) then 1353 1354 1355 print *,'Guide: probleme -> pas de fichierhur.nc'1356 1357 1358 1359 1360 print *,'Guide: probleme -> pas de variable RH, fichierhur.nc'1361 1362 1363 print*,'ncidQ,varidQ',ncidQ,varidQ1364 1523 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1524 IF (rcode.NE.NF_NOERR) THEN 1525 abort_message='Nudging: error -> no file hur.nc' 1526 CALL abort_gcm(modname,abort_message,1) 1527 ENDIF 1528 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1529 IF (rcode.NE.NF_NOERR) THEN 1530 abort_message='Nudging: error -> no RH,variable in file hur.nc' 1531 CALL abort_gcm(modname,abort_message,1) 1532 ENDIF 1533 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1534 if (ncidpl.eq.-99) ncidpl=ncidQ 1365 1535 endif 1366 1536 ! Pression de surface 1367 1537 if ((guide_P).OR.(guide_modele)) then 1368 1369 1370 print *,'Guide: probleme -> pas de fichierps.nc'1371 1372 1373 1374 1375 print *,'Guide: probleme -> pas de variable SP, fichierps.nc'1376 1377 1378 print*,'ncidps,varidps',ncidps,varidps1538 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1539 IF (rcode.NE.NF_NOERR) THEN 1540 abort_message='Nudging: error -> no file ps.nc' 1541 CALL abort_gcm(modname,abort_message,1) 1542 ENDIF 1543 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1544 IF (rcode.NE.NF_NOERR) THEN 1545 abort_message='Nudging: error -> no SP variable in file ps.nc' 1546 CALL abort_gcm(modname,abort_message,1) 1547 ENDIF 1548 write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps 1379 1549 endif 1380 1550 ! Coordonnee verticale 1381 if ( .not.guide_modele) then1382 1383 1384 print*,'ncidpl,varidpl',ncidpl,varidpl1551 if (guide_plevs.EQ.0) then 1552 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1553 IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1554 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1385 1555 endif 1386 1556 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1387 if (guide_ modele) then1557 if (guide_plevs.EQ.1) then 1388 1558 #ifdef NC_DOUBLE 1389 1559 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) … … 1393 1563 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 1394 1564 #endif 1395 else 1565 elseif (guide_plevs.EQ.0) THEN 1396 1566 #ifdef NC_DOUBLE 1397 1567 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) … … 1420 1590 count(4)=1 1421 1591 1592 ! Pression 1593 if (guide_plevs.EQ.2) then 1594 #ifdef NC_DOUBLE 1595 status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu) 1596 #else 1597 status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu) 1598 #endif 1599 DO i=1,iip1 1600 pnat2(i,:,:)=zu(:,:) 1601 ENDDO 1602 1603 IF (invert_y) THEN 1604 ! PRINT*,"Invertion impossible actuellement" 1605 ! CALL abort_gcm(modname,abort_message,1) 1606 CALL invert_lat(iip1,jjp1,nlevnc,pnat2) 1607 ENDIF 1608 endif 1422 1609 ! Vent zonal 1423 1610 if (guide_u) then … … 1490 1677 1491 1678 ! Pression de surface 1492 if ((guide_P).OR.(guide_ modele)) then1679 if ((guide_P).OR.(guide_plevs.EQ.1)) then 1493 1680 start(3)=timestep 1494 1681 start(4)=0 … … 1543 1730 INTEGER :: ierr, varid,l 1544 1731 REAL, DIMENSION (iip1,hsize,vsize) :: field2 1545 1546 print *,'Guide: output timestep',timestep,'var ',varname 1732 CHARACTER(LEN=20),PARAMETER :: modname="guide_out" 1733 1734 write(*,*)trim(modname)//': output timestep',timestep,'var ',varname 1547 1735 IF (timestep.EQ.0) THEN 1548 1736 ! ---------------------------------------------- … … 1566 1754 ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev) 1567 1755 ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu) 1756 ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv) 1568 1757 ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au) 1569 ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)1570 1758 ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av) 1571 1759 call nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), & … … 1604 1792 ! -------------------------------------------------------------------- 1605 1793 ierr = NF_REDEF(nid) 1606 ! Surface pressure (GCM)1607 dim 3=(/id_lonv,id_latu,id_tim/)1608 ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT, 3,dim3,varid)1794 ! Pressure (GCM) 1795 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1796 ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid) 1609 1797 ! Surface pressure (guidage) 1610 1798 IF (guide_P) THEN … … 1651 1839 SELECT CASE (varname) 1652 1840 CASE ("SP","ps") 1653 start=(/1,1, timestep,0/)1654 count=(/iip1,jjp1, 1,0/)1841 start=(/1,1,1,timestep/) 1842 count=(/iip1,jjp1,llm,1/) 1655 1843 CASE ("v","va","vcov") 1656 1844 start=(/1,1,1,timestep/) -
LMDZ6/trunk/libf/dyn3dmem/guide_loc_mod.F90
r3984 r3995 9 9 !======================================================================= 10 10 11 USE getparam 11 USE getparam, only: ini_getparam, fin_getparam, getpar 12 12 USE Write_Field_loc 13 13 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, & 14 14 nf90_inq_dimid, nf90_inquire_dimension 15 15 USE parallel_lmdz 16 USE pres2lev_mod 16 USE pres2lev_mod, only: pres2lev 17 17 18 18 IMPLICIT NONE … … 63 63 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: psgui1,psgui2 64 64 65 INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev ,ijnu,ijnv65 INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv 66 66 INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv 67 67 … … 175 175 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 176 176 if (rcod.NE.NF_NOERR) THEN 177 print *,'Guide: probleme -> pas de fichierapbp.nc'177 abort_message=' Nudging error -> no file apbp.nc' 178 178 CALL abort_gcm(modname,abort_message,1) 179 179 endif … … 183 183 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 184 184 if (rcod.NE.NF_NOERR) THEN 185 print *,'Guide: probleme -> pas de fichierP.nc'185 abort_message=' Nudging error -> no file P.nc' 186 186 CALL abort_gcm(modname,abort_message,1) 187 187 endif … … 192 192 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 193 193 if (rcod.NE.NF_NOERR) THEN 194 print *,'Guide: probleme -> pas de fichieru.nc'194 abort_message=' Nudging error -> no file u.nc' 195 195 CALL abort_gcm(modname,abort_message,1) 196 196 endif … … 203 203 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 204 204 if (rcod.NE.NF_NOERR) THEN 205 print *,'Guide: probleme -> pas de fichierv.nc'205 abort_message=' Nudging error -> no file v.nc' 206 206 CALL abort_gcm(modname,abort_message,1) 207 207 endif … … 213 213 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 214 214 if (rcod.NE.NF_NOERR) THEN 215 print *,'Guide: probleme -> pas de fichierT.nc'215 abort_message=' Nudging error -> no file T.nc' 216 216 CALL abort_gcm(modname,abort_message,1) 217 217 endif … … 224 224 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 225 225 if (rcod.NE.NF_NOERR) THEN 226 print *,'Guide: probleme -> pas de fichierhur.nc'226 abort_message=' Nudging error -> no file hur.nc' 227 227 CALL abort_gcm(modname,abort_message,1) 228 228 endif … … 234 234 IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 235 235 IF (error.NE.NF_NOERR) THEN 236 print *,'Guide: probleme lecture niveaux pression'236 abort_message='Nudging: error reading pressure levels' 237 237 CALL abort_gcm(modname,abort_message,1) 238 238 ENDIF 239 239 error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc) 240 print *,'Guide: nombre niveaux vert. nlevnc', nlevnc240 write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc 241 241 rcod = nf90_close(ncidpl) 242 242 … … 244 244 ! Allocation des variables 245 245 ! --------------------------------------------- 246 abort_message=' pb in allocation guide'246 abort_message='nudging allocation error' 247 247 248 248 ALLOCATE(apnc(nlevnc), stat = error) … … 395 395 396 396 INTEGER :: i,j,l 397 INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM397 CHARACTER(LEN=20) :: modname="guide_main" 398 398 399 399 !$OMP MASTER 400 ijbu=ij_begin ; ijeu=ij_end ; ijnu=ijeu-ijbu+1400 ijbu=ij_begin ; ijeu=ij_end 401 401 jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1 402 ijbv=ij_begin ; ijev=ij_end ; ijnv=ijev-ijbv+1402 ijbv=ij_begin ; ijev=ij_end 403 403 jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1 404 404 IF (pole_sud) THEN 405 ijeu=ij_end-iip1 405 406 ijev=ij_end-iip1 406 407 jjev=jj_end-1 407 ijnv=ijev-ijbv+1408 408 jjnv=jjev-jjbv+1 409 ENDIF 410 IF (pole_nord) THEN 411 ijbu=ij_begin+iip1 412 ijbv=ij_begin 409 413 ENDIF 410 414 !$OMP END MASTER … … 493 497 IF (reste.EQ.0.) THEN 494 498 IF (itau_test.EQ.itau) THEN 495 write(*,*)'deuxieme passage de advreel a itau=',itau 496 stop 499 write(*,*)trim(modname)//' second pass in advreel at itau=',& 500 itau 501 stop 497 502 ELSE 498 503 !$OMP MASTER … … 507 512 step_rea=step_rea+1 508 513 itau_test=itau 509 print*,'Lecture fichiers guidage, pas ',step_rea, & 510 'apres ',count_no_rea,' non lectures' 514 if (is_master) then 515 write(*,*)trim(modname)//' Reading nudging files, step ',& 516 step_rea,'after ',count_no_rea,' skips' 517 endif 511 518 IF (guide_2D) THEN 512 519 !$OMP MASTER … … 547 554 548 555 549 556 !----------------------------------------------------------------------- 550 557 ! Ajout des champs de guidage 551 558 !----------------------------------------------------------------------- … … 576 583 ENDDO 577 584 578 !!$OMP MASTER579 ! DO l=1,llm,5580 ! print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()581 ! print*,'avant dump2d l=',l,mpi_rank582 ! CALL dump2d(iip1,jjnb_u,p(:,l),'ppp ')583 ! ENDDO584 !!$OMP END MASTER585 !!$OMP BARRIER586 587 585 CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.) 588 586 ENDIF … … 605 603 if (guide_zon) CALL guide_zonave_u(1,llm,f_addu) 606 604 CALL guide_addfield_u(llm,f_addu,alpha_u) 607 ! IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)608 605 IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt) 609 606 IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt) 610 IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt) 607 IF (f_out) THEN 608 ! Ehouarn: fill the gaps adequately... 609 IF (ijbu>ijb_u) f_addu(ijb_u:ijbu-1,:)=0 610 IF (ijeu<ije_u) f_addu(ijeu+1:ije_u,:)=0 611 CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt) 612 ENDIF 611 613 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 612 614 DO l=1,llm … … 703 705 IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt) 704 706 IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt) 705 IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt) 707 IF (f_out) THEN 708 ! Ehouarn: Fill in the gaps adequately 709 IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0 710 IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0 711 CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt) 712 ENDIF 706 713 707 714 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) … … 939 946 940 947 INTEGER :: i,j,l,ij 948 CHARACTER(LEN=20),PARAMETER :: modname="guide_interp" 941 949 TYPE(Request),SAVE :: Req 942 950 !$OMP THREADPRIVATE(Req) 943 print *,'Guide: conversion variables guidage' 951 952 if (is_master) write(*,*)trim(modname)//': interpolate nudging variables' 944 953 ! ----------------------------------------------------------------- 945 954 ! Calcul des niveaux de pression champs guidage (pour T et Q) … … 986 995 first=.FALSE. 987 996 !$OMP MASTER 988 print*,'Guide: verification ordre niveaux verticaux'989 print*,'LMDZ :'997 write(*,*)trim(modname)//' : check vertical level order' 998 write(*,*)trim(modname)//' LMDZ :' 990 999 do l=1,llm 991 print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &1000 write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. & 992 1001 +psi(1,jjeu)*(bp(l)+bp(l+1))/2. 993 1002 enddo 994 print*,'Fichiers guidage'1003 write(*,*)trim(modname)//' nudging file :' 995 1004 SELECT CASE (guide_plevs) 996 1005 CASE (0) 997 1006 do l=1,nlevnc 998 print*,'PL(',l,')=',plnc2(1,jjbu,l)1007 write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l) 999 1008 enddo 1000 1009 CASE (1) 1001 1010 DO l=1,nlevnc 1002 print*,'PL(',l,')=',apnc(l)+bpnc(l)*psnat2(i,jjbu) 1003 ENDDO 1011 write(*,*)trim(modname)//' PL(',l,')=',& 1012 apnc(l)+bpnc(l)*psnat2(i,jjbu) 1013 ENDDO 1004 1014 CASE (2) 1005 1015 do l=1,nlevnc 1006 print*,'PL(',l,')=',pnat2(1,jjbu,l)1016 write(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l) 1007 1017 enddo 1008 1018 END SELECT 1009 print *,'inversion de l''ordre: invert_p=',invert_p1019 write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p 1010 1020 if (guide_u) then 1011 1021 do l=1,nlevnc 1012 print*,'U(',l,')=',unat2(1,jjbu,l)1022 write(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l) 1013 1023 enddo 1014 1024 endif 1015 1025 if (guide_T) then 1016 1026 do l=1,nlevnc 1017 print*,'T(',l,')=',tnat2(1,jjbu,l)1027 write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l) 1018 1028 enddo 1019 1029 endif 1020 1030 !$OMP END MASTER 1021 endif 1031 endif ! of if (first) 1022 1032 1023 1033 ! ----------------------------------------------------------------- … … 1415 1425 real alphamin,alphamax,xi 1416 1426 integer i,j,ilon,ilat 1427 character(len=20),parameter :: modname="tau2alpha" 1417 1428 1418 1429 … … 1503 1514 ! Calcul de gamma 1504 1515 if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then 1505 print*,'ATTENTION modele peu zoome'1506 print*,'ATTENTION on prend une constante de guidage cste'1507 1516 write(*,*)trim(modname)//' ATTENTION modele peu zoome' 1517 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' 1518 gamma=0. 1508 1519 else 1509 1510 print*,'gamma=',gamma1511 1512 print*,'gamma =',gamma,'<1e-5'1513 1514 1515 1516 1517 1518 1519 print*,'gamma=',gamma1520 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1521 write(*,*)trim(modname)//' gamma=',gamma 1522 if (gamma.lt.1.e-5) then 1523 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1524 stop 1525 endif 1526 gamma=log(0.5)/log(gamma) 1527 if (gamma4) then 1528 gamma=min(gamma,4.) 1529 endif 1530 write(*,*)trim(modname)//' gamma=',gamma 1520 1531 endif 1521 1532 ENDIF !first … … 1558 1569 IMPLICIT NONE 1559 1570 1560 #include "netcdf.inc"1561 #include "dimensions.h"1562 #include "paramet.h"1571 include "netcdf.inc" 1572 include "dimensions.h" 1573 include "paramet.h" 1563 1574 1564 1575 INTEGER, INTENT(IN) :: timestep … … 1582 1593 if (first) then 1583 1594 ncidpl=-99 1584 print*,'Guide: ouverture des fichiers guidage'1595 write(*,*),trim(modname)//': opening nudging files ' 1585 1596 ! Ap et Bp si Niveaux de pression hybrides 1586 1597 if (guide_plevs.EQ.1) then 1587 print *,'Lecture du guidage sur niveaux modele'1598 write(*,*),trim(modname)//' Reading nudging on model levels' 1588 1599 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1589 1600 IF (rcode.NE.NF_NOERR) THEN 1590 print *,'Guide: probleme -> pas de fichierapbp.nc'1601 abort_message='Nudging: error -> no file apbp.nc' 1591 1602 CALL abort_gcm(modname,abort_message,1) 1592 1603 ENDIF 1593 1604 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1594 1605 IF (rcode.NE.NF_NOERR) THEN 1595 print *,'Guide: probleme -> pas de variable AP, fichierapbp.nc'1606 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1596 1607 CALL abort_gcm(modname,abort_message,1) 1597 1608 ENDIF 1598 1609 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1599 1610 IF (rcode.NE.NF_NOERR) THEN 1600 print *,'Guide: probleme -> pas de variable BP, fichierapbp.nc'1611 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1601 1612 CALL abort_gcm(modname,abort_message,1) 1602 1613 ENDIF 1603 print*,'ncidpl,varidap',ncidpl,varidap1614 write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap 1604 1615 endif 1605 1616 … … 1608 1619 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1609 1620 IF (rcode.NE.NF_NOERR) THEN 1610 print *,'Guide: probleme -> pas de fichierP.nc'1621 abort_message='Nudging: error -> no file P.nc' 1611 1622 CALL abort_gcm(modname,abort_message,1) 1612 1623 ENDIF 1613 1624 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1614 1625 IF (rcode.NE.NF_NOERR) THEN 1615 print *,'Guide: probleme -> pas de variable PRES, fichierP.nc'1626 abort_message='Nudging: error -> no PRES variable in file P.nc' 1616 1627 CALL abort_gcm(modname,abort_message,1) 1617 1628 ENDIF 1618 print*,'ncidp,varidp',ncidp,varidp1629 write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp 1619 1630 if (ncidpl.eq.-99) ncidpl=ncidp 1620 1631 endif … … 1624 1635 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1625 1636 IF (rcode.NE.NF_NOERR) THEN 1626 print *,'Guide: probleme -> pas de fichieru.nc'1637 abort_message='Nudging: error -> no file u.nc' 1627 1638 CALL abort_gcm(modname,abort_message,1) 1628 1639 ENDIF 1629 1640 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1630 1641 IF (rcode.NE.NF_NOERR) THEN 1631 print *,'Guide: probleme -> pas de variable UWND, fichieru.nc'1642 abort_message='Nudging: error -> no UWND variable in file u.nc' 1632 1643 CALL abort_gcm(modname,abort_message,1) 1633 1644 ENDIF 1634 print*,'ncidu,varidu',ncidu,varidu1645 write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu 1635 1646 if (ncidpl.eq.-99) ncidpl=ncidu 1636 1647 … … 1639 1650 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1640 1651 IF (lendim .NE. iip1) THEN 1641 print *,'dimension LONU different from iip1 in u.nc'1652 abort_message='dimension LONU different from iip1 in u.nc' 1642 1653 CALL abort_gcm(modname,abort_message,1) 1643 1654 ENDIF … … 1646 1657 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1647 1658 IF (lendim .NE. jjp1) THEN 1648 print *,'dimension LATU different from jjp1 in u.nc'1659 abort_message='dimension LATU different from jjp1 in u.nc' 1649 1660 CALL abort_gcm(modname,abort_message,1) 1650 1661 ENDIF … … 1656 1667 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1657 1668 IF (rcode.NE.NF_NOERR) THEN 1658 print *,'Guide: probleme -> pas de fichierv.nc'1669 abort_message='Nudging: error -> no file v.nc' 1659 1670 CALL abort_gcm(modname,abort_message,1) 1660 1671 ENDIF 1661 1672 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1662 1673 IF (rcode.NE.NF_NOERR) THEN 1663 print *,'Guide: probleme -> pas de variable VWND, fichierv.nc'1674 abort_message='Nudging: error -> no VWND variable in file v.nc' 1664 1675 CALL abort_gcm(modname,abort_message,1) 1665 1676 ENDIF 1666 print*,'ncidv,varidv',ncidv,varidv1677 write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv 1667 1678 if (ncidpl.eq.-99) ncidpl=ncidv 1668 1679 … … 1671 1682 1672 1683 IF (lendim .NE. iip1) THEN 1673 print *,'dimension LONV different from iip1 in v.nc'1684 abort_message='dimension LONV different from iip1 in v.nc' 1674 1685 CALL abort_gcm(modname,abort_message,1) 1675 1686 ENDIF … … 1679 1690 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1680 1691 IF (lendim .NE. jjm) THEN 1681 print *,'dimension LATV different from jjm in v.nc'1692 abort_message='dimension LATV different from jjm in v.nc' 1682 1693 CALL abort_gcm(modname,abort_message,1) 1683 1694 ENDIF … … 1689 1700 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1690 1701 IF (rcode.NE.NF_NOERR) THEN 1691 print *,'Guide: probleme -> pas de fichierT.nc'1702 abort_message='Nudging: error -> no file T.nc' 1692 1703 CALL abort_gcm(modname,abort_message,1) 1693 1704 ENDIF 1694 1705 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1695 1706 IF (rcode.NE.NF_NOERR) THEN 1696 print *,'Guide: probleme -> pas de variable AIR, fichierT.nc'1707 abort_message='Nudging: error -> no AIR variable in file T.nc' 1697 1708 CALL abort_gcm(modname,abort_message,1) 1698 1709 ENDIF 1699 print*,'ncidT,varidT',ncidt,varidt1710 write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt 1700 1711 if (ncidpl.eq.-99) ncidpl=ncidt 1701 1712 … … 1703 1714 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1704 1715 IF (lendim .NE. iip1) THEN 1705 print *,'dimension LONV different from iip1 in T.nc'1716 abort_message='dimension LONV different from iip1 in T.nc' 1706 1717 CALL abort_gcm(modname,abort_message,1) 1707 1718 ENDIF … … 1710 1721 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1711 1722 IF (lendim .NE. jjp1) THEN 1712 print *,'dimension LATU different from jjp1 in T.nc'1723 abort_message='dimension LATU different from jjp1 in T.nc' 1713 1724 CALL abort_gcm(modname,abort_message,1) 1714 1725 ENDIF … … 1720 1731 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1721 1732 IF (rcode.NE.NF_NOERR) THEN 1722 print *,'Guide: probleme -> pas de fichierhur.nc'1733 abort_message='Nudging: error -> no file hur.nc' 1723 1734 CALL abort_gcm(modname,abort_message,1) 1724 1735 ENDIF 1725 1736 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1726 1737 IF (rcode.NE.NF_NOERR) THEN 1727 print *,'Guide: probleme -> pas de variable RH, fichierhur.nc'1738 abort_message='Nudging: error -> no RH variable in file hur.nc' 1728 1739 CALL abort_gcm(modname,abort_message,1) 1729 1740 ENDIF 1730 print*,'ncidQ,varidQ',ncidQ,varidQ1741 write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1731 1742 if (ncidpl.eq.-99) ncidpl=ncidQ 1732 1743 … … 1735 1746 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1736 1747 IF (lendim .NE. iip1) THEN 1737 print *,'dimension LONV different from iip1 in hur.nc'1748 abort_message='dimension LONV different from iip1 in hur.nc' 1738 1749 CALL abort_gcm(modname,abort_message,1) 1739 1750 ENDIF … … 1742 1753 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1743 1754 IF (lendim .NE. jjp1) THEN 1744 print *,'dimension LATU different from jjp1 in hur.nc'1755 abort_message='dimension LATU different from jjp1 in hur.nc' 1745 1756 CALL abort_gcm(modname,abort_message,1) 1746 1757 ENDIF … … 1752 1763 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1753 1764 IF (rcode.NE.NF_NOERR) THEN 1754 print *,'Guide: probleme -> pas de fichierps.nc'1765 abort_message='Nudging: error -> no file ps.nc' 1755 1766 CALL abort_gcm(modname,abort_message,1) 1756 1767 ENDIF 1757 1768 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1758 1769 IF (rcode.NE.NF_NOERR) THEN 1759 print *,'Guide: probleme -> pas de variable SP, fichierps.nc'1770 abort_message='Nudging: error -> no SP variable in file ps.nc' 1760 1771 CALL abort_gcm(modname,abort_message,1) 1761 1772 ENDIF 1762 print*,'ncidps,varidps',ncidps,varidps1773 write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps 1763 1774 endif 1764 1775 ! Coordonnee verticale … … 1766 1777 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1767 1778 IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1768 print*,'ncidpl,varidpl',ncidpl,varidpl1779 write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1769 1780 endif 1770 1781 ! Coefs ap, bp pour calcul de la pression aux differents niveaux … … 1911 1922 IMPLICIT NONE 1912 1923 1913 #include "netcdf.inc"1914 #include "dimensions.h"1915 #include "paramet.h"1924 include "netcdf.inc" 1925 include "dimensions.h" 1926 include "paramet.h" 1916 1927 1917 1928 INTEGER, INTENT(IN) :: timestep … … 1938 1949 if (first) then 1939 1950 ncidpl=-99 1940 print*,'Guide: ouverture des fichiers guidage'1951 write(*,*)trim(modname)//' : opening nudging files ' 1941 1952 ! Ap et Bp si niveaux de pression hybrides 1942 1953 if (guide_plevs.EQ.1) then 1943 print *,'Lecture du guidage sur niveaux mod�le'1944 1945 1946 print *,'Guide: probleme -> pas de fichierapbp.nc'1947 1948 1949 1950 1951 print *,'Guide: probleme -> pas de variable AP, fichierapbp.nc'1952 1953 1954 1955 1956 print *,'Guide: probleme -> pas de variable BP, fichierapbp.nc'1957 1958 1959 print*,'ncidpl,varidap',ncidpl,varidap1954 write(*,*)trim(modname)//' Reading nudging on model levels' 1955 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1956 IF (rcode.NE.NF_NOERR) THEN 1957 abort_message='Nudging: error -> no file apbp.nc' 1958 CALL abort_gcm(modname,abort_message,1) 1959 ENDIF 1960 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1961 IF (rcode.NE.NF_NOERR) THEN 1962 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1963 CALL abort_gcm(modname,abort_message,1) 1964 ENDIF 1965 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1966 IF (rcode.NE.NF_NOERR) THEN 1967 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1968 CALL abort_gcm(modname,abort_message,1) 1969 ENDIF 1970 write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap 1960 1971 endif 1961 1972 ! Pression 1962 1973 if (guide_plevs.EQ.2) then 1963 1964 1965 print *,'Guide: probleme -> pas de fichierP.nc'1966 1967 1968 1969 1970 print *,'Guide: probleme -> pas de variable PRES, fichierP.nc'1971 1972 1973 print*,'ncidp,varidp',ncidp,varidp1974 1974 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1975 IF (rcode.NE.NF_NOERR) THEN 1976 abort_message='Nudging: error -> no file P.nc' 1977 CALL abort_gcm(modname,abort_message,1) 1978 ENDIF 1979 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1980 IF (rcode.NE.NF_NOERR) THEN 1981 abort_message='Nudging: error -> no PRES variable in file P.nc' 1982 CALL abort_gcm(modname,abort_message,1) 1983 ENDIF 1984 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1985 if (ncidpl.eq.-99) ncidpl=ncidp 1975 1986 endif 1976 1987 ! Vent zonal 1977 1988 if (guide_u) then 1978 1979 1980 print *,'Guide: probleme -> pas de fichieru.nc'1981 1982 1983 1984 1985 print *,'Guide: probleme -> pas de variable UWND, fichieru.nc'1986 1987 1988 print*,'ncidu,varidu',ncidu,varidu1989 1989 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1990 IF (rcode.NE.NF_NOERR) THEN 1991 abort_message='Nudging: error -> no file u.nc' 1992 CALL abort_gcm(modname,abort_message,1) 1993 ENDIF 1994 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1995 IF (rcode.NE.NF_NOERR) THEN 1996 abort_message='Nudging: error -> no UWND variable in file u.nc' 1997 CALL abort_gcm(modname,abort_message,1) 1998 ENDIF 1999 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 2000 if (ncidpl.eq.-99) ncidpl=ncidu 1990 2001 endif 1991 2002 1992 2003 ! Vent meridien 1993 2004 if (guide_v) then 1994 1995 1996 print *,'Guide: probleme -> pas de fichierv.nc'1997 1998 1999 2000 2001 print *,'Guide: probleme -> pas de variable VWND, fichierv.nc'2002 2003 2004 print*,'ncidv,varidv',ncidv,varidv2005 2006 2005 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 2006 IF (rcode.NE.NF_NOERR) THEN 2007 abort_message='Nudging: error -> no file v.nc' 2008 CALL abort_gcm(modname,abort_message,1) 2009 ENDIF 2010 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 2011 IF (rcode.NE.NF_NOERR) THEN 2012 abort_message='Nudging: error -> no VWND variable in file v.nc' 2013 CALL abort_gcm(modname,abort_message,1) 2014 ENDIF 2015 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 2016 if (ncidpl.eq.-99) ncidpl=ncidv 2017 endif 2007 2018 ! Temperature 2008 2019 if (guide_T) then 2009 2010 2011 print *,'Guide: probleme -> pas de fichierT.nc'2012 2013 2014 2015 2016 print *,'Guide: probleme -> pas de variable AIR, fichierT.nc'2017 2018 2019 print*,'ncidT,varidT',ncidt,varidt2020 2020 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 2021 IF (rcode.NE.NF_NOERR) THEN 2022 abort_message='Nudging: error -> no file T.nc' 2023 CALL abort_gcm(modname,abort_message,1) 2024 ENDIF 2025 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 2026 IF (rcode.NE.NF_NOERR) THEN 2027 abort_message='Nudging: error -> no AIR variable in file T.nc' 2028 CALL abort_gcm(modname,abort_message,1) 2029 ENDIF 2030 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 2031 if (ncidpl.eq.-99) ncidpl=ncidt 2021 2032 endif 2022 2033 ! Humidite 2023 2034 if (guide_Q) then 2024 2025 2026 print *,'Guide: probleme -> pas de fichierhur.nc'2027 2028 2029 2030 2031 print *,'Guide: probleme -> pas de variable RH, fichierhur.nc'2032 2033 2034 print*,'ncidQ,varidQ',ncidQ,varidQ2035 2035 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 2036 IF (rcode.NE.NF_NOERR) THEN 2037 abort_message='Nudging: error -> no file hur.nc' 2038 CALL abort_gcm(modname,abort_message,1) 2039 ENDIF 2040 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 2041 IF (rcode.NE.NF_NOERR) THEN 2042 abort_message='Nudging: error -> no RH,variable in file hur.nc' 2043 CALL abort_gcm(modname,abort_message,1) 2044 ENDIF 2045 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 2046 if (ncidpl.eq.-99) ncidpl=ncidQ 2036 2047 endif 2037 2048 ! Pression de surface 2038 2049 if ((guide_P).OR.(guide_plevs.EQ.1)) then 2039 2040 2041 print *,'Guide: probleme -> pas de fichierps.nc'2042 2043 2044 2045 2046 print *,'Guide: probleme -> pas de variable SP, fichierps.nc'2047 2048 2049 print*,'ncidps,varidps',ncidps,varidps2050 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 2051 IF (rcode.NE.NF_NOERR) THEN 2052 abort_message='Nudging: error -> no file ps.nc' 2053 CALL abort_gcm(modname,abort_message,1) 2054 ENDIF 2055 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 2056 IF (rcode.NE.NF_NOERR) THEN 2057 abort_message='Nudging: error -> no SP variable in file ps.nc' 2058 CALL abort_gcm(modname,abort_message,1) 2059 ENDIF 2060 write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps 2050 2061 endif 2051 2062 ! Coordonnee verticale 2052 2063 if (guide_plevs.EQ.0) then 2053 2054 2055 print*,'ncidpl,varidpl',ncidpl,varidpl2064 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 2065 IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 2066 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 2056 2067 endif 2057 2068 ! Coefs ap, bp pour calcul de la pression aux differents niveaux … … 2247 2258 REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1) 2248 2259 REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo 2260 CHARACTER(LEN=20),PARAMETER :: modname="guide_out" 2249 2261 2250 2262 !$OMP MASTER … … 2253 2265 !$OMP BARRIER 2254 2266 2255 print*,'gvide_out apresallocation ',hsize,vsize2267 ! write(*,*)trim(modname)//' after allocation ',hsize,vsize 2256 2268 2257 2269 IF (hsize==jjp1) THEN … … 2261 2273 ENDIF 2262 2274 2263 print*,'guide_out apresgather '2275 ! write(*,*)trim(modname)//' after gather ' 2264 2276 CALL Gather_field_u(alpha_u,zu,1) 2265 2277 CALL Gather_field_u(alpha_t,zt,1) … … 2431 2443 !$OMP BARRIER 2432 2444 2433 RETURN2434 2435 2445 END SUBROUTINE guide_out 2436 2446 -
LMDZ6/trunk/libf/dyn3dmem/parallel_lmdz.F90
r2771 r3995 12 12 INTEGER,PARAMETER :: halo_max=3 13 13 14 LOGICAL,SAVE :: using_mpi 15 LOGICAL,SAVE :: using_omp 14 LOGICAL,SAVE :: using_mpi ! .true. if using MPI 15 LOGICAL,SAVE :: using_omp ! .true. if using OpenMP 16 LOGICAL,SAVE :: is_master ! .true. if the core is both MPI & OpenMP master 17 !$OMP THREADPRIVATE(is_master) 16 18 17 19 integer, save :: mpi_size … … 248 250 !$OMP END PARALLEL 249 251 CALL create_distrib(jj_nb_para,current_dist) 252 253 IF ((mpi_rank==0).and.(omp_rank==0)) THEN 254 is_master=.true. 255 ELSE 256 is_master=.false. 257 ENDIF 250 258 251 259 end subroutine init_parallel
Note: See TracChangeset
for help on using the changeset viewer.