Changeset 4482 for LMDZ6/branches/LMDZ_ECRad/libf/dyn3d
- Timestamp:
- Mar 29, 2023, 3:14:27 PM (22 months ago)
- Location:
- LMDZ6/branches/LMDZ_ECRad
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ_ECRad
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/bilan_dyn.F
r2601 r4482 185 185 WRITE(lunout,*)'dt_app=',dt_app 186 186 WRITE(lunout,*)'dt_cum=',dt_cum 187 stop187 call abort_gcm('bilan_dyn','stopped',1) 188 188 endif 189 189 -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/check_isotopes.F90
r4143 r4482 2 2 USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str 3 3 USE infotrac, ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, & 4 ntiso, iH2O, nzone, tracers, isoName, itZonIso, tnat4 ntiso, iH2O, nzone, tracers, isoName, itZonIso, getKey 5 5 IMPLICIT NONE 6 6 include "dimensions.h" … … 10 10 CHARACTER(LEN=maxlen) :: modname, msg1, nm(2) 11 11 INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar 12 INTEGER, ALLOCATABLE :: ix(:) 12 INTEGER, ALLOCATABLE :: ix(:) 13 REAL, ALLOCATABLE, SAVE :: tnat(:) 13 14 REAL :: xtractot, xiiso, deltaD, q1, q2 14 15 REAL, PARAMETER :: borne = 1e19, & … … 28 29 IF(niso == 0) RETURN !--- No isotopes => finished 29 30 IF(first) THEN 30 iso_eau = strIdx(isoName,'H2[16]O') 31 iso_HDO = strIdx(isoName,'H[2]HO') 32 iso_O18 = strIdx(isoName,'H2[18]O') 33 iso_O17 = strIdx(isoName,'H2[17]O') 34 iso_HTO = strIdx(isoName,'H[3]HO') 31 iso_eau = strIdx(isoName,'H216O') 32 iso_HDO = strIdx(isoName,'HDO') 33 iso_O18 = strIdx(isoName,'H218O') 34 iso_O17 = strIdx(isoName,'H217O') 35 iso_HTO = strIdx(isoName,'HTO') 36 IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1) 35 37 first = .FALSE. 36 38 END IF -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/conf_gcm.F90
r4100 r4482 415 415 write(lunout,*)'conf_gcm: La valeur de clat passee par run.def', & 416 416 ' est differente de celle lue sur le fichier start ' 417 STOP417 CALL abort_gcm("conf_gcm","stopped",1) 418 418 ENDIF 419 419 … … 429 429 write(lunout,*)'conf_gcm: La valeur de grossismx passee par ', & 430 430 'run.def est differente de celle lue sur le fichier start ' 431 STOP431 CALL abort_gcm("conf_gcm","stopped",1) 432 432 ENDIF 433 433 … … 443 443 write(lunout,*)'conf_gcm: La valeur de grossismy passee par ', & 444 444 'run.def est differente de celle lue sur le fichier start ' 445 STOP445 CALL abort_gcm("conf_gcm","stopped",1) 446 446 ENDIF 447 447 … … 449 449 write(lunout,*) & 450 450 'conf_gcm: *** ATTENTION !! grossismx < 1 . *** ' 451 STOP451 CALL abort_gcm("conf_gcm","stopped",1) 452 452 ELSE 453 453 alphax = 1. - 1./ grossismx … … 457 457 write(lunout,*) & 458 458 'conf_gcm: *** ATTENTION !! grossismy < 1 . *** ' 459 STOP459 CALL abort_gcm("conf_gcm","stopped",1) 460 460 ELSE 461 461 alphay = 1. - 1./ grossismy … … 479 479 write(lunout,*)' *** fxyhypb lu sur le fichier start est ', & 480 480 'F alors qu il est T sur run.def ***' 481 STOP481 CALL abort_gcm("conf_gcm","stopped",1) 482 482 ENDIF 483 483 ELSE … … 486 486 write(lunout,*)' *** fxyhypb lu sur le fichier start est ', & 487 487 'T alors qu il est F sur run.def **** ' 488 STOP488 CALL abort_gcm("conf_gcm","stopped",1) 489 489 ENDIF 490 490 ENDIF … … 502 502 write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ', & 503 503 'run.def est differente de celle lue sur le fichier start ' 504 STOP504 CALL abort_gcm("conf_gcm","stopped",1) 505 505 ENDIF 506 506 ENDIF … … 518 518 write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ', & 519 519 'run.def est differente de celle lue sur le fichier start ' 520 STOP520 CALL abort_gcm("conf_gcm","stopped",1) 521 521 ENDIF 522 522 ENDIF … … 533 533 write(lunout,*)'conf_gcm: La valeur de taux passee par ', & 534 534 'run.def est differente de celle lue sur le fichier start ' 535 STOP535 CALL abort_gcm("conf_gcm","stopped",1) 536 536 ENDIF 537 537 ENDIF … … 548 548 write(lunout,*)'conf_gcm: La valeur de tauy passee par ', & 549 549 'run.def est differente de celle lue sur le fichier start ' 550 STOP550 CALL abort_gcm("conf_gcm","stopped",1) 551 551 ENDIF 552 552 ENDIF … … 569 569 write(lunout,*)' *** ysinus lu sur le fichier start est F', & 570 570 ' alors qu il est T sur run.def ***' 571 STOP571 CALL abort_gcm("conf_gcm","stopped",1) 572 572 ENDIF 573 573 ELSE … … 576 576 write(lunout,*)' *** ysinus lu sur le fichier start est T', & 577 577 ' alors qu il est F sur run.def **** ' 578 STOP578 CALL abort_gcm("conf_gcm","stopped",1) 579 579 ENDIF 580 580 ENDIF … … 599 599 type_trac = 'lmdz' 600 600 CALL getin('type_trac',type_trac) 601 602 !Config Key = config_inca603 !Config Desc = Choix de configuration de INCA604 !Config Def = none605 !Config Help = Choix de configuration de INCA :606 !Config 'none' = sans INCA607 !Config 'chem' = INCA avec calcul de chemie608 !Config 'aero' = INCA avec calcul des aerosols609 config_inca = 'none'610 CALL getin('config_inca',config_inca)611 601 612 602 !Config Key = ok_dynzon … … 672 662 write(lunout,*)' offline = ', offline 673 663 write(lunout,*)' type_trac = ', type_trac 674 write(lunout,*)' config_inca = ', config_inca675 664 write(lunout,*)' ok_dynzon = ', ok_dynzon 676 665 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins … … 712 701 write(lunout,*) & 713 702 'conf_gcm: *** ATTENTION !! grossismx < 1 . *** ' 714 STOP703 CALL abort_gcm("conf_gcm","stopped",1) 715 704 ELSE 716 705 alphax = 1. - 1./ grossismx … … 719 708 IF( grossismy.LT.1. ) THEN 720 709 write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** ' 721 STOP710 CALL abort_gcm("conf_gcm","stopped",1) 722 711 ELSE 723 712 alphay = 1. - 1./ grossismy … … 795 784 type_trac = 'lmdz' 796 785 CALL getin('type_trac',type_trac) 797 798 !Config Key = config_inca799 !Config Desc = Choix de configuration de INCA800 !Config Def = none801 !Config Help = Choix de configuration de INCA :802 !Config 'none' = sans INCA803 !Config 'chem' = INCA avec calcul de chemie804 !Config 'aero' = INCA avec calcul des aerosols805 config_inca = 'none'806 CALL getin('config_inca',config_inca)807 786 808 787 !Config Key = ok_dynzon … … 912 891 write(lunout,*)' offline = ', offline 913 892 write(lunout,*)' type_trac = ', type_trac 914 write(lunout,*)' config_inca = ', config_inca915 893 write(lunout,*)' ok_dynzon = ', ok_dynzon 916 894 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynetat0.F90
r4203 r4482 6 6 ! Purpose: Initial state reading. 7 7 !------------------------------------------------------------------------------- 8 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O8 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 9 9 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str 10 10 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, & 11 11 NF90_CLOSE, NF90_GET_VAR, NF90_NoErr 12 USE readTracFiles_mod, ONLY: new2old Name12 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey 13 13 USE control_mod, ONLY: planet_type 14 14 USE assert_eq_m, ONLY: assert_eq … … 41 41 INTEGER, PARAMETER :: length=100 42 42 INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase 43 REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE 43 REAL :: time, tnat, alpha_ideal, tab_cntrl(length) !--- RUN PARAMS TABLE 44 LOGICAL :: lSkip, ll 44 45 !------------------------------------------------------------------------------- 45 46 modname="dynetat0" … … 127 128 128 129 !--- Tracers 130 ll=.FALSE. 131 #ifdef REPROBUS 132 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE 133 #endif 129 134 DO iq=1,nqtot 130 135 var = tracers(iq)%name 131 oldVar = new2oldName(var) 132 !-------------------------------------------------------------------------------------------------------------------------- 133 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr) THEN !=== REGULAR CASE 136 oldVar = new2oldH2O(var) 137 lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" 138 #ifdef REPROBUS 139 ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions 140 #endif 141 #ifdef INCA 142 IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION 143 #endif 144 !-------------------------------------------------------------------------------------------------------------------------- 145 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE 134 146 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var) 135 147 !-------------------------------------------------------------------------------------------------------------------------- 136 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== OLDNAME148 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME 137 149 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname) 138 150 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",oldVar) 139 151 !-------------------------------------------------------------------------------------------------------------------------- 140 #ifdef INCA141 ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN !=== INCA: OX INSTEAD OF O3142 CALL msg('Tracer <O3> is missing => initialized to <OX>', modname)143 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",'OX')144 !--------------------------------------------------------------------------------------------------------------------------145 #endif146 152 ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES 147 153 iName = tracers(iq)%iso_iName … … 149 155 iqParent = tracers(iq)%iqParent 150 156 IF(tracers(iq)%iso_iZone == 0) THEN 157 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 158 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 151 159 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname) 152 q(:,:,:,iq) = q(:,:,:,iqParent)*tnat (iName)*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)160 q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.) 153 161 ELSE 154 162 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname) -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/dynredem.F90
r4170 r4482 167 167 !------------------------------------------------------------------------------- 168 168 USE strings_mod, ONLY: maxlen 169 USE infotrac, ONLY: nqtot, tracers, type s_trac169 USE infotrac, ONLY: nqtot, tracers, type_trac 170 170 USE control_mod 171 171 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, & … … 228 228 !--- Tracers in file "start_trac.nc" (added by Anne) 229 229 lread_inca=.FALSE.; fil="start_trac.nc" 230 IF(ANY(type s_trac=='inca') .OR. ANY(types_trac=='inco')) INQUIRE(FILE=fil,EXIST=lread_inca)230 IF(ANY(type_trac == ['inca','inco'])) INQUIRE(FILE=fil,EXIST=lread_inca) 231 231 IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open") 232 232 -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/gcm.F90
r3579 r4482 20 20 21 21 USE filtreg_mod 22 USE infotrac 22 USE infotrac, ONLY: nqtot, init_infotrac 23 23 USE control_mod 24 24 USE mod_const_mpi, ONLY: COMM_LMDZ … … 178 178 #ifdef CPP_IOIPSL 179 179 if (calend == 'earth_360d') then 180 call ioconf_calendar('360 d')180 call ioconf_calendar('360_day') 181 181 write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an' 182 182 else if (calend == 'earth_365d') then … … 205 205 ! Choix du nombre de traceurs et du schema pour l'advection 206 206 ! dans fichier traceur.def, par default ou via INCA 207 call in fotrac_init207 call init_infotrac 208 208 209 209 ! Allocation de la tableau q : champs advectes -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/groupe.F
r2600 r4482 51 51 if (firstcall) then 52 52 if (groupe_ok) then 53 if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point' 53 if(mod(iim,2**ngroup).ne.0) 54 & CALL abort_gcm('groupe','probleme du nombre de point',1) 54 55 endif 55 56 firstcall=.false. -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/guide_mod.F90
r3995 r4482 39 39 REAL, PRIVATE, SAVE :: lon_min_g,lon_max_g 40 40 REAL, PRIVATE, SAVE :: tau_lon,tau_lat 41 42 REAL, PRIVATE, SAVE :: plim_guide_BL 41 43 42 44 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u,alpha_v … … 67 69 SUBROUTINE guide_init 68 70 71 use netcdf, only: nf90_noerr 69 72 USE control_mod, ONLY: day_step 70 73 USE serre_mod, ONLY: grossismx … … 113 116 CALL getpar('gamma4',.false.,gamma4,'Zone sans rappel elargie') 114 117 CALL getpar('guide_BL',.true.,guide_BL,'guidage dans C.Lim') 118 CALL getpar('plim_guide_BL',85000.,plim_guide_BL,'BL top presnivs value') 119 115 120 116 121 ! Sauvegarde du for�age … … 169 174 if (ncidpl.eq.-99) then 170 175 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 171 if (rcod.NE.NF _NOERR) THEN176 if (rcod.NE.NF90_NOERR) THEN 172 177 abort_message=' Nudging error -> no file apbp.nc' 173 178 CALL abort_gcm(modname,abort_message,1) … … 177 182 if (ncidpl.EQ.-99) then 178 183 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 179 if (rcod.NE.NF _NOERR) THEN184 if (rcod.NE.NF90_NOERR) THEN 180 185 abort_message=' Nudging error -> no file P.nc' 181 186 CALL abort_gcm(modname,abort_message,1) … … 186 191 if (ncidpl.eq.-99) then 187 192 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 188 if (rcod.NE.NF _NOERR) THEN193 if (rcod.NE.NF90_NOERR) THEN 189 194 CALL abort_gcm(modname, & 190 195 ' Nudging error -> no file u.nc',1) … … 195 200 if (ncidpl.eq.-99) then 196 201 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 197 if (rcod.NE.NF _NOERR) THEN202 if (rcod.NE.NF90_NOERR) THEN 198 203 CALL abort_gcm(modname, & 199 204 ' Nudging error -> no file v.nc',1) … … 203 208 if (ncidpl.eq.-99) then 204 209 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 205 if (rcod.NE.NF _NOERR) THEN210 if (rcod.NE.NF90_NOERR) THEN 206 211 CALL abort_gcm(modname, & 207 212 ' Nudging error -> no file T.nc',1) … … 211 216 if (ncidpl.eq.-99) then 212 217 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 213 if (rcod.NE.NF _NOERR) THEN218 if (rcod.NE.NF90_NOERR) THEN 214 219 CALL abort_gcm(modname, & 215 220 ' Nudging error -> no file hur.nc',1) … … 220 225 endif 221 226 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 222 IF (error.NE.NF _NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)223 IF (error.NE.NF _NOERR) THEN227 IF (error.NE.NF90_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 228 IF (error.NE.NF90_NOERR) THEN 224 229 CALL abort_gcm(modname,'Nudging: error reading pressure levels',1) 225 230 ENDIF … … 354 359 INCLUDE "dimensions.h" 355 360 INCLUDE "paramet.h" 361 INCLUDE "iniprint.h" 362 356 363 357 364 ! Variables entree … … 377 384 INTEGER :: l 378 385 CHARACTER(LEN=20) :: modname="guide_main" 386 CHARACTER (len = 80) :: abort_message 387 379 388 380 389 !----------------------------------------------------------------------- … … 399 408 else 400 409 do l=1,llm 401 alpha_pcor(l)=(1.+tanh((0.85-presnivs(l)/preff)/0.05))/2.410 alpha_pcor(l)=(1.+tanh(((plim_guide_BL-presnivs(l))/preff)/0.05))/2. 402 411 enddo 403 412 endif … … 442 451 IF (reste.EQ.0.) THEN 443 452 IF (itau_test.EQ.itau) THEN 444 write( *,*)trim(modname)//' second pass in advreel at itau=',&453 write(lunout,*)trim(modname)//' second pass in advreel at itau=',& 445 454 itau 446 stop 455 abort_message='stopped' 456 CALL abort_gcm(modname,abort_message,1) 447 457 ELSE 448 458 IF (guide_v) vnat1=vnat2 … … 937 947 integer i,j,ilon,ilat 938 948 character(len=20),parameter :: modname="tau2alpha" 949 CHARACTER (len = 80) :: abort_message 939 950 940 951 … … 1033 1044 if (gamma.lt.1.e-5) then 1034 1045 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1035 stop 1046 abort_message='stopped' 1047 CALL abort_gcm(modname,abort_message,1) 1036 1048 endif 1037 1049 gamma=log(0.5)/log(gamma) … … 1078 1090 SUBROUTINE guide_read(timestep) 1079 1091 1092 use netcdf, only: NF90_GET_VAR, nf90_noerr 1093 1080 1094 IMPLICIT NONE 1081 1095 1082 include "netcdf.inc"1083 1096 include "dimensions.h" 1084 1097 include "paramet.h" … … 1103 1116 if (first) then 1104 1117 ncidpl=-99 1105 write(*,*) ,trim(modname)//': opening nudging files '1118 write(*,*) trim(modname)//': opening nudging files ' 1106 1119 ! Niveaux de pression si non constants 1107 1120 if (guide_plevs.EQ.1) then 1108 write(*,*) ,trim(modname)//' Reading nudging on model levels'1121 write(*,*) trim(modname)//' Reading nudging on model levels' 1109 1122 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1110 IF (rcode.NE.NF _NOERR) THEN1123 IF (rcode.NE.NF90_NOERR) THEN 1111 1124 abort_message='Nudging: error -> no file apbp.nc' 1112 1125 CALL abort_gcm(modname,abort_message,1) 1113 1126 ENDIF 1114 1127 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1115 IF (rcode.NE.NF _NOERR) THEN1128 IF (rcode.NE.NF90_NOERR) THEN 1116 1129 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1117 1130 CALL abort_gcm(modname,abort_message,1) 1118 1131 ENDIF 1119 1132 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1120 IF (rcode.NE.NF _NOERR) THEN1133 IF (rcode.NE.NF90_NOERR) THEN 1121 1134 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1122 1135 CALL abort_gcm(modname,abort_message,1) 1123 1136 ENDIF 1124 write(*,*) ,trim(modname)//' ncidpl,varidap',ncidpl,varidap1137 write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap 1125 1138 endif 1126 1139 … … 1128 1141 if (guide_plevs.EQ.2) then 1129 1142 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1130 IF (rcode.NE.NF _NOERR) THEN1143 IF (rcode.NE.NF90_NOERR) THEN 1131 1144 abort_message='Nudging: error -> no file P.nc' 1132 1145 CALL abort_gcm(modname,abort_message,1) 1133 1146 ENDIF 1134 1147 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1135 IF (rcode.NE.NF _NOERR) THEN1148 IF (rcode.NE.NF90_NOERR) THEN 1136 1149 abort_message='Nudging: error -> no PRES variable in file P.nc' 1137 1150 CALL abort_gcm(modname,abort_message,1) 1138 1151 ENDIF 1139 write(*,*) ,trim(modname)//' ncidp,varidp',ncidp,varidp1152 write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp 1140 1153 if (ncidpl.eq.-99) ncidpl=ncidp 1141 1154 endif … … 1144 1157 if (guide_u) then 1145 1158 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1146 IF (rcode.NE.NF _NOERR) THEN1159 IF (rcode.NE.NF90_NOERR) THEN 1147 1160 abort_message='Nudging: error -> no file u.nc' 1148 1161 CALL abort_gcm(modname,abort_message,1) 1149 1162 ENDIF 1150 1163 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1151 IF (rcode.NE.NF _NOERR) THEN1164 IF (rcode.NE.NF90_NOERR) THEN 1152 1165 abort_message='Nudging: error -> no UWND variable in file u.nc' 1153 1166 CALL abort_gcm(modname,abort_message,1) 1154 1167 ENDIF 1155 write(*,*) ,trim(modname)//' ncidu,varidu',ncidu,varidu1168 write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu 1156 1169 if (ncidpl.eq.-99) ncidpl=ncidu 1157 1170 … … 1175 1188 if (guide_v) then 1176 1189 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1177 IF (rcode.NE.NF _NOERR) THEN1190 IF (rcode.NE.NF90_NOERR) THEN 1178 1191 abort_message='Nudging: error -> no file v.nc' 1179 1192 CALL abort_gcm(modname,abort_message,1) 1180 1193 ENDIF 1181 1194 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1182 IF (rcode.NE.NF _NOERR) THEN1195 IF (rcode.NE.NF90_NOERR) THEN 1183 1196 abort_message='Nudging: error -> no VWND variable in file v.nc' 1184 1197 CALL abort_gcm(modname,abort_message,1) 1185 1198 ENDIF 1186 write(*,*) ,trim(modname)//' ncidv,varidv',ncidv,varidv1199 write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv 1187 1200 if (ncidpl.eq.-99) ncidpl=ncidv 1188 1201 … … 1208 1221 if (guide_T) then 1209 1222 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1210 IF (rcode.NE.NF _NOERR) THEN1223 IF (rcode.NE.NF90_NOERR) THEN 1211 1224 abort_message='Nudging: error -> no file T.nc' 1212 1225 CALL abort_gcm(modname,abort_message,1) 1213 1226 ENDIF 1214 1227 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1215 IF (rcode.NE.NF _NOERR) THEN1228 IF (rcode.NE.NF90_NOERR) THEN 1216 1229 abort_message='Nudging: error -> no AIR variable in file T.nc' 1217 1230 CALL abort_gcm(modname,abort_message,1) 1218 1231 ENDIF 1219 write(*,*) ,trim(modname)//' ncidT,varidT',ncidt,varidt1232 write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt 1220 1233 if (ncidpl.eq.-99) ncidpl=ncidt 1221 1234 … … 1239 1252 if (guide_Q) then 1240 1253 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1241 IF (rcode.NE.NF _NOERR) THEN1254 IF (rcode.NE.NF90_NOERR) THEN 1242 1255 abort_message='Nudging: error -> no file hur.nc' 1243 1256 CALL abort_gcm(modname,abort_message,1) 1244 1257 ENDIF 1245 1258 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1246 IF (rcode.NE.NF _NOERR) THEN1259 IF (rcode.NE.NF90_NOERR) THEN 1247 1260 abort_message='Nudging: error -> no RH variable in file hur.nc' 1248 1261 CALL abort_gcm(modname,abort_message,1) 1249 1262 ENDIF 1250 write(*,*) ,trim(modname)//' ncidQ,varidQ',ncidQ,varidQ1263 write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1251 1264 if (ncidpl.eq.-99) ncidpl=ncidQ 1252 1265 … … 1270 1283 if ((guide_P).OR.(guide_modele)) then 1271 1284 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1272 IF (rcode.NE.NF _NOERR) THEN1285 IF (rcode.NE.NF90_NOERR) THEN 1273 1286 abort_message='Nudging: error -> no file ps.nc' 1274 1287 CALL abort_gcm(modname,abort_message,1) 1275 1288 ENDIF 1276 1289 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1277 IF (rcode.NE.NF _NOERR) THEN1290 IF (rcode.NE.NF90_NOERR) THEN 1278 1291 abort_message='Nudging: error -> no SP variable in file ps.nc' 1279 1292 CALL abort_gcm(modname,abort_message,1) 1280 1293 ENDIF 1281 write(*,*) ,trim(modname)//' ncidps,varidps',ncidps,varidps1294 write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps 1282 1295 endif 1283 1296 ! Coordonnee verticale … … 1285 1298 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1286 1299 IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1287 write(*,*) ,trim(modname)//' ncidpl,varidpl',ncidpl,varidpl1300 write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1288 1301 endif 1289 1302 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1290 1303 if (guide_plevs.EQ.1) then 1291 #ifdef NC_DOUBLE 1292 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) 1293 status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc) 1294 #else 1295 status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc) 1296 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 1297 #endif 1304 status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc]) 1305 status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc]) 1298 1306 ELSEIF (guide_plevs.EQ.0) THEN 1299 #ifdef NC_DOUBLE 1300 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) 1301 #else 1302 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc) 1303 #endif 1307 status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc]) 1304 1308 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous 1305 1309 IF(convert_Pa) apnc=apnc*100.! conversion en Pascals … … 1326 1330 ! Pression 1327 1331 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 1332 status=NF90_GET_VAR(ncidp,varidp,pnat2,start,count) 1333 1333 IF (invert_y) THEN 1334 1334 ! PRINT*,"Invertion impossible actuellement" … … 1340 1340 ! Vent zonal 1341 1341 if (guide_u) then 1342 #ifdef NC_DOUBLE 1343 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unat2) 1344 #else 1345 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unat2) 1346 #endif 1342 status=NF90_GET_VAR(ncidu,varidu,unat2,start,count) 1347 1343 IF (invert_y) THEN 1348 1344 CALL invert_lat(iip1,jjp1,nlevnc,unat2) … … 1352 1348 ! Temperature 1353 1349 if (guide_T) then 1354 #ifdef NC_DOUBLE 1355 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnat2) 1356 #else 1357 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnat2) 1358 #endif 1350 status=NF90_GET_VAR(ncidt,varidt,tnat2,start,count) 1359 1351 IF (invert_y) THEN 1360 1352 CALL invert_lat(iip1,jjp1,nlevnc,tnat2) … … 1364 1356 ! Humidite 1365 1357 if (guide_Q) then 1366 #ifdef NC_DOUBLE 1367 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,qnat2) 1368 #else 1369 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,qnat2) 1370 #endif 1358 status=NF90_GET_VAR(ncidQ,varidQ,qnat2,start,count) 1371 1359 IF (invert_y) THEN 1372 1360 CALL invert_lat(iip1,jjp1,nlevnc,qnat2) … … 1378 1366 if (guide_v) then 1379 1367 count(2)=jjm 1380 #ifdef NC_DOUBLE 1381 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnat2) 1382 #else 1383 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnat2) 1384 #endif 1368 status=NF90_GET_VAR(ncidv,varidv,vnat2,start,count) 1385 1369 IF (invert_y) THEN 1386 1370 CALL invert_lat(iip1,jjm,nlevnc,vnat2) … … 1395 1379 count(3)=1 1396 1380 count(4)=0 1397 #ifdef NC_DOUBLE 1398 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnat2) 1399 #else 1400 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnat2) 1401 #endif 1381 status=NF90_GET_VAR(ncidps,varidps,psnat2,start,count) 1402 1382 IF (invert_y) THEN 1403 1383 CALL invert_lat(iip1,jjp1,1,psnat2) … … 1410 1390 SUBROUTINE guide_read2D(timestep) 1411 1391 1392 use netcdf, only: nf90_get_var, nf90_noerr 1393 1412 1394 IMPLICIT NONE 1413 1395 1414 include "netcdf.inc"1415 1396 include "dimensions.h" 1416 1397 include "paramet.h" … … 1443 1424 write(*,*)trim(modname)//' Reading nudging on model levels' 1444 1425 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1445 IF (rcode.NE.NF _NOERR) THEN1426 IF (rcode.NE.NF90_NOERR) THEN 1446 1427 abort_message='Nudging: error -> no file apbp.nc' 1447 1428 CALL abort_gcm(modname,abort_message,1) 1448 1429 ENDIF 1449 1430 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1450 IF (rcode.NE.NF _NOERR) THEN1431 IF (rcode.NE.NF90_NOERR) THEN 1451 1432 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1452 1433 CALL abort_gcm(modname,abort_message,1) 1453 1434 ENDIF 1454 1435 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1455 IF (rcode.NE.NF _NOERR) THEN1436 IF (rcode.NE.NF90_NOERR) THEN 1456 1437 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1457 1438 CALL abort_gcm(modname,abort_message,1) … … 1462 1443 if (guide_plevs.EQ.2) then 1463 1444 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1464 IF (rcode.NE.NF _NOERR) THEN1445 IF (rcode.NE.NF90_NOERR) THEN 1465 1446 abort_message='Nudging: error -> no file P.nc' 1466 1447 CALL abort_gcm(modname,abort_message,1) 1467 1448 ENDIF 1468 1449 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1469 IF (rcode.NE.NF _NOERR) THEN1450 IF (rcode.NE.NF90_NOERR) THEN 1470 1451 abort_message='Nudging: error -> no PRES variable in file P.nc' 1471 1452 CALL abort_gcm(modname,abort_message,1) … … 1477 1458 if (guide_u) then 1478 1459 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1479 IF (rcode.NE.NF _NOERR) THEN1460 IF (rcode.NE.NF90_NOERR) THEN 1480 1461 abort_message='Nudging: error -> no file u.nc' 1481 1462 CALL abort_gcm(modname,abort_message,1) 1482 1463 ENDIF 1483 1464 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1484 IF (rcode.NE.NF _NOERR) THEN1465 IF (rcode.NE.NF90_NOERR) THEN 1485 1466 abort_message='Nudging: error -> no UWND variable in file u.nc' 1486 1467 CALL abort_gcm(modname,abort_message,1) … … 1492 1473 if (guide_v) then 1493 1474 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1494 IF (rcode.NE.NF _NOERR) THEN1475 IF (rcode.NE.NF90_NOERR) THEN 1495 1476 abort_message='Nudging: error -> no file v.nc' 1496 1477 CALL abort_gcm(modname,abort_message,1) 1497 1478 ENDIF 1498 1479 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1499 IF (rcode.NE.NF _NOERR) THEN1480 IF (rcode.NE.NF90_NOERR) THEN 1500 1481 abort_message='Nudging: error -> no VWND variable in file v.nc' 1501 1482 CALL abort_gcm(modname,abort_message,1) … … 1507 1488 if (guide_T) then 1508 1489 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1509 IF (rcode.NE.NF _NOERR) THEN1490 IF (rcode.NE.NF90_NOERR) THEN 1510 1491 abort_message='Nudging: error -> no file T.nc' 1511 1492 CALL abort_gcm(modname,abort_message,1) 1512 1493 ENDIF 1513 1494 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1514 IF (rcode.NE.NF _NOERR) THEN1495 IF (rcode.NE.NF90_NOERR) THEN 1515 1496 abort_message='Nudging: error -> no AIR variable in file T.nc' 1516 1497 CALL abort_gcm(modname,abort_message,1) … … 1522 1503 if (guide_Q) then 1523 1504 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1524 IF (rcode.NE.NF _NOERR) THEN1505 IF (rcode.NE.NF90_NOERR) THEN 1525 1506 abort_message='Nudging: error -> no file hur.nc' 1526 1507 CALL abort_gcm(modname,abort_message,1) 1527 1508 ENDIF 1528 1509 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1529 IF (rcode.NE.NF _NOERR) THEN1510 IF (rcode.NE.NF90_NOERR) THEN 1530 1511 abort_message='Nudging: error -> no RH,variable in file hur.nc' 1531 1512 CALL abort_gcm(modname,abort_message,1) … … 1537 1518 if ((guide_P).OR.(guide_modele)) then 1538 1519 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1539 IF (rcode.NE.NF _NOERR) THEN1520 IF (rcode.NE.NF90_NOERR) THEN 1540 1521 abort_message='Nudging: error -> no file ps.nc' 1541 1522 CALL abort_gcm(modname,abort_message,1) 1542 1523 ENDIF 1543 1524 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1544 IF (rcode.NE.NF _NOERR) THEN1525 IF (rcode.NE.NF90_NOERR) THEN 1545 1526 abort_message='Nudging: error -> no SP variable in file ps.nc' 1546 1527 CALL abort_gcm(modname,abort_message,1) … … 1556 1537 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1557 1538 if (guide_plevs.EQ.1) then 1558 #ifdef NC_DOUBLE 1559 status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc) 1560 status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc) 1561 #else 1562 status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc) 1563 status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc) 1564 #endif 1539 status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc]) 1540 status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc]) 1565 1541 elseif (guide_plevs.EQ.0) THEN 1566 #ifdef NC_DOUBLE 1567 status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc) 1568 #else 1569 status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc) 1570 #endif 1542 status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc]) 1571 1543 apnc=apnc*100.! conversion en Pascals 1572 1544 bpnc(:)=0. … … 1592 1564 ! Pression 1593 1565 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 1566 status=NF90_GET_VAR(ncidp,varidp,zu,start,count) 1599 1567 DO i=1,iip1 1600 1568 pnat2(i,:,:)=zu(:,:) … … 1609 1577 ! Vent zonal 1610 1578 if (guide_u) then 1611 #ifdef NC_DOUBLE 1612 status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,zu) 1613 #else 1614 status=NF_GET_VARA_REAL(ncidu,varidu,start,count,zu) 1615 #endif 1579 status=NF90_GET_VAR(ncidu,varidu,zu,start,count) 1616 1580 DO i=1,iip1 1617 1581 unat2(i,:,:)=zu(:,:) … … 1626 1590 ! Temperature 1627 1591 if (guide_T) then 1628 #ifdef NC_DOUBLE 1629 status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,zu) 1630 #else 1631 status=NF_GET_VARA_REAL(ncidt,varidt,start,count,zu) 1632 #endif 1592 status=NF90_GET_VAR(ncidt,varidt,zu,start,count) 1633 1593 DO i=1,iip1 1634 1594 tnat2(i,:,:)=zu(:,:) … … 1643 1603 ! Humidite 1644 1604 if (guide_Q) then 1645 #ifdef NC_DOUBLE 1646 status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,zu) 1647 #else 1648 status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,zu) 1649 #endif 1605 status=NF90_GET_VAR(ncidQ,varidQ,zu,start,count) 1650 1606 DO i=1,iip1 1651 1607 qnat2(i,:,:)=zu(:,:) … … 1661 1617 if (guide_v) then 1662 1618 count(2)=jjm 1663 #ifdef NC_DOUBLE 1664 status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,zv) 1665 #else 1666 status=NF_GET_VARA_REAL(ncidv,varidv,start,count,zv) 1667 #endif 1619 status=NF90_GET_VAR(ncidv,varidv,zv,start,count) 1668 1620 DO i=1,iip1 1669 1621 vnat2(i,:,:)=zv(:,:) … … 1683 1635 count(3)=1 1684 1636 count(4)=0 1685 #ifdef NC_DOUBLE 1686 status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,zu(:,1)) 1687 #else 1688 status=NF_GET_VARA_REAL(ncidps,varidps,start,count,zu(:,1)) 1689 #endif 1637 status=NF90_GET_VAR(ncidps,varidps,zu(:,1),start,count) 1690 1638 DO i=1,iip1 1691 1639 psnat2(i,:)=zu(:,1) … … 1706 1654 USE comvert_mod, ONLY: presnivs 1707 1655 use netcdf95, only: nf95_def_var, nf95_put_var 1708 use netcdf, only: nf90_float 1656 use netcdf, only: nf90_float, nf90_def_var 1709 1657 1710 1658 IMPLICIT NONE … … 1748 1696 1749 1697 ! Creation des variables dimensions 1750 ierr=NF _DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu)1751 ierr=NF _DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv)1752 ierr=NF _DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu)1753 ierr=NF _DEF_VAR(nid,"LATV",NF_FLOAT,1,id_latv,vid_latv)1754 ierr=NF _DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)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)1757 ierr=NF _DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)1758 ierr=NF _DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)1698 ierr=NF90_DEF_VAR(nid,"LONU",NF90_FLOAT,id_lonu,vid_lonu) 1699 ierr=NF90_DEF_VAR(nid,"LONV",NF90_FLOAT,id_lonv,vid_lonv) 1700 ierr=NF90_DEF_VAR(nid,"LATU",NF90_FLOAT,id_latu,vid_latu) 1701 ierr=NF90_DEF_VAR(nid,"LATV",NF90_FLOAT,id_latv,vid_latv) 1702 ierr=NF90_DEF_VAR(nid,"LEVEL",NF90_FLOAT,id_lev,vid_lev) 1703 ierr=NF90_DEF_VAR(nid,"cu",NF90_FLOAT,(/id_lonu,id_latu/),vid_cu) 1704 ierr=NF90_DEF_VAR(nid,"cv",NF90_FLOAT,(/id_lonv,id_latv/),vid_cv) 1705 ierr=NF90_DEF_VAR(nid,"au",NF90_FLOAT,(/id_lonu,id_latu/),vid_au) 1706 ierr=NF90_DEF_VAR(nid,"av",NF90_FLOAT,(/id_lonv,id_latv/),vid_av) 1759 1707 call nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), & 1760 1708 varid_alpha_t) … … 1794 1742 ! Pressure (GCM) 1795 1743 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1796 ierr = NF _DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)1744 ierr = NF90_DEF_VAR(nid,"SP",NF90_FLOAT,dim4,varid) 1797 1745 ! Surface pressure (guidage) 1798 1746 IF (guide_P) THEN 1799 1747 dim3=(/id_lonv,id_latu,id_tim/) 1800 ierr = NF _DEF_VAR(nid,"ps",NF_FLOAT,3,dim3,varid)1748 ierr = NF90_DEF_VAR(nid,"ps",NF90_FLOAT,dim3,varid) 1801 1749 ENDIF 1802 1750 ! Zonal wind 1803 1751 IF (guide_u) THEN 1804 1752 dim4=(/id_lonu,id_latu,id_lev,id_tim/) 1805 ierr = NF _DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)1806 ierr = NF _DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)1807 ierr = NF _DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)1753 ierr = NF90_DEF_VAR(nid,"u",NF90_FLOAT,dim4,varid) 1754 ierr = NF90_DEF_VAR(nid,"ua",NF90_FLOAT,dim4,varid) 1755 ierr = NF90_DEF_VAR(nid,"ucov",NF90_FLOAT,dim4,varid) 1808 1756 ENDIF 1809 1757 ! Merid. wind 1810 1758 IF (guide_v) THEN 1811 1759 dim4=(/id_lonv,id_latv,id_lev,id_tim/) 1812 ierr = NF _DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)1813 ierr = NF _DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)1814 ierr = NF _DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)1760 ierr = NF90_DEF_VAR(nid,"v",NF90_FLOAT,dim4,varid) 1761 ierr = NF90_DEF_VAR(nid,"va",NF90_FLOAT,dim4,varid) 1762 ierr = NF90_DEF_VAR(nid,"vcov",NF90_FLOAT,dim4,varid) 1815 1763 ENDIF 1816 1764 ! Pot. Temperature 1817 1765 IF (guide_T) THEN 1818 1766 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1819 ierr = NF _DEF_VAR(nid,"teta",NF_FLOAT,4,dim4,varid)1767 ierr = NF90_DEF_VAR(nid,"teta",NF90_FLOAT,dim4,varid) 1820 1768 ENDIF 1821 1769 ! Specific Humidity 1822 1770 IF (guide_Q) THEN 1823 1771 dim4=(/id_lonv,id_latu,id_lev,id_tim/) 1824 ierr = NF _DEF_VAR(nid,"q",NF_FLOAT,4,dim4,varid)1772 ierr = NF90_DEF_VAR(nid,"q",NF90_FLOAT,dim4,varid) 1825 1773 ENDIF 1826 1774 -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/iniacademic.F90
r4143 r4482 5 5 6 6 USE filtreg_mod, ONLY: inifilr 7 USE infotrac, ONLY: nqtot, niso, tnat, alpha_ideal, iqIsoPha, tracers7 USE infotrac, ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName 8 8 USE control_mod, ONLY: day_step,planet_type 9 9 use exner_hyb_m, only: exner_hyb … … 18 18 USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm 19 19 USE logic_mod, ONLY: iflag_phys, read_start 20 USE comvert_mod, ONLY: ap, bp, preff, p resnivs, pressure_exner20 USE comvert_mod, ONLY: ap, bp, preff, pa, presnivs, pressure_exner 21 21 USE temps_mod, ONLY: annee_ref, day_ini, day_ref 22 22 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 23 23 USE readTracFiles_mod, ONLY: addPhase 24 use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID 25 use netcdf, only : NF90_CLOSE, NF90_GET_VAR 26 24 27 25 28 ! Author: Frederic Hourdin original: 15/01/93 … … 64 67 INTEGER i,j,l,lsup,ij, iq, iName, iPhase, iqParent 65 68 69 integer :: nid_relief,varid,ierr 70 real, dimension(iip1,jjp1) :: relief 71 66 72 REAL teta0,ttp,delt_y,delt_z,eps ! Constantes pour profil de T 67 73 REAL k_f,k_c_a,k_c_s ! Constantes de rappel … … 73 79 integer idum 74 80 75 REAL zdtvr 81 REAL zdtvr, tnat, alpha_ideal 76 82 77 83 character(len=*),parameter :: modname="iniacademic" … … 118 124 CALL inifilr 119 125 126 127 !------------------------------------------------------------------ 120 128 ! Initialize pressure and mass field if read_start=.false. 129 !------------------------------------------------------------------ 130 121 131 IF (.NOT. read_start) THEN 122 ! surface pressure 123 if (iflag_phys>2) then 124 ! specific value for CMIP5 aqua/terra planets 125 ! "Specify the initial dry mass to be equivalent to 126 ! a global mean surface pressure (101325 minus 245) Pa." 127 ps(:)=101080. 128 else 129 ! use reference surface pressure 130 ps(:)=preff 132 133 !------------------------------------------------------------------ 134 ! Lecture eventuelle d'un fichier de relief interpollee sur la grille 135 ! du modele. 136 ! On suppose que le fichier relief_in.nc est stoké sur une grille 137 ! iim*jjp1 138 ! Facile a créer à partir de la commande 139 ! cdo remapcon,fichier_output_phys.nc Relief.nc relief_in.nc 140 !------------------------------------------------------------------ 141 142 relief=0. 143 ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief) 144 if (ierr.EQ.NF90_NOERR) THEN 145 ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid) 146 if (ierr==NF90_NOERR) THEN 147 ierr=NF90_GET_VAR(nid_relief,varid,relief(1:iim,1:jjp1)) 148 relief(iip1,:)=relief(1,:) 149 else 150 CALL abort_gcm ('iniacademic','variable RELIEF pas la',1) 151 endif 131 152 endif 153 ierr = NF90_CLOSE (nid_relief) 154 155 !------------------------------------------------------------------ 156 ! Initialisation du geopotentiel au sol et de la pression 157 !------------------------------------------------------------------ 158 159 print*,'relief=',minval(relief),maxval(relief),'g=',g 160 do j=1,jjp1 161 do i=1,iip1 162 phis((j-1)*iip1+i)=g*relief(i,j) 163 enddo 164 enddo 165 print*,'phis=',minval(phis),maxval(phis),'g=',g 132 166 133 167 ! ground geopotential 134 phis(:)=0. 168 !phis(:)=0. 169 ps(:)=preff 135 170 CALL pression ( ip1jmp1, ap, bp, ps, p ) 136 171 … … 286 321 iqParent = tracers(iq)%iqParent 287 322 IF(tracers(iq)%iso_iZone == 0) THEN 288 q(:,:,iq) = q(:,:,iqParent)*tnat(iName)*(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.) 323 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 324 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 325 q(:,:,iq) = q(:,:,iqParent)*tnat*(q(:,:,iqParent)/30.e-3)**(alpha_ideal-1.) 289 326 ELSE 290 327 q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase)) -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/replay3d.F90
r4113 r4482 170 170 171 171 CALL suphel 172 open(82,file='dump_param.bin',form='unformatted',status='old')172 !open(82,file='dump_param.bin',form='unformatted',status='old') 173 173 174 174 -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/vlsplt.F
r4143 r4482 184 184 DO ij=iip2,ip1jm-1 185 185 dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq) 186 c IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'187 c sigu(ij)=u_m(ij,l)/masse(ij,l,iq)188 186 ENDDO 189 187 DO ij=iip1+iip1,ip1jm,iip1 … … 310 308 ENDDO 311 309 #endif 312 c stop313 310 314 311 c go to 9999 … … 437 434 enddo 438 435 enddo 439 do ifils=1,tracers(iq)%nqChild s436 do ifils=1,tracers(iq)%nqChildren 440 437 iq2=tracers(iq)%iqDescen(ifils) 441 438 call vlx(Ratio,pente_max,masseq,u_mq,iq2) … … 969 966 ! CRisi: appel récursif de l'advection sur les fils. 970 967 ! Il faut faire ça avant d'avoir mis à jour q et masse 971 !write(*,*) 'vlsplt 942: iq,nqChild s(iq)=',iq,nqChilds(iq)968 !write(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq) 972 969 do ifils=1,tracers(iq)%nqDescen 973 970 iq2=tracers(iq)%iqDescen(ifils) … … 987 984 enddo 988 985 989 do ifils=1,tracers(iq)%nqChild s986 do ifils=1,tracers(iq)%nqChildren 990 987 iq2=tracers(iq)%iqDescen(ifils) 991 988 call vlz(Ratio,pente_max,masseq,wq,iq2) -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/vlspltqs.F
r4052 r4482 248 248 DO ij=iip2,ip1jm-1 249 249 dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq) 250 c IF(u_m(ij,l).lt.0.) stop'limx n admet pas les U<0'251 c sigu(ij)=u_m(ij,l)/masse(ij,l,iq)252 250 ENDDO 253 251 DO ij=iip1+iip1,ip1jm,iip1 … … 479 477 ! CRisi: appel récursif de l'advection sur les fils. 480 478 ! Il faut faire ça avant d'avoir mis à jour q et masse 481 !write(*,*) 'vlspltqs 326: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds 479 !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq, 480 ! & tracers(iq)%nqChildren 482 481 483 482 do ifils=1,tracers(iq)%nqDescen … … 491 490 enddo 492 491 enddo 493 do ifils=1,tracers(iq)%nqChild s492 do ifils=1,tracers(iq)%nqChildren 494 493 iq2=tracers(iq)%iqDescen(ifils) 495 494 call vlx(Ratio,pente_max,masseq,u_mq,iq2) … … 786 785 ! CRisi: appel récursif de l'advection sur les fils. 787 786 ! Il faut faire ça avant d'avoir mis à jour q et masse 788 !write(*,*) 'vlyqs 689: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds 787 !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq, 788 ! & tracers(iq)%nqChildren 789 789 790 790 do ifils=1,tracers(iq)%nqDescen … … 797 797 enddo 798 798 enddo 799 do ifils=1,tracers(iq)%nqChild s799 do ifils=1,tracers(iq)%nqChildren 800 800 iq2=tracers(iq)%iqDescen(ifils) 801 801 !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2 -
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d/wrgrads.F
r1907 r4482 80 80 print*,'nvar ',nvar(if) 81 81 print*,'vars ',(var(iv,if),iv=1,nvar(if)) 82 83 stop 82 CALL abort_gcm("wrgrads","problem",1) 84 83 endif 85 84 endif
Note: See TracChangeset
for help on using the changeset viewer.