Index: LMDZ6/trunk/libf/dyn3d/abort_gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/abort_gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/abort_gcm.F90 (revision 5267) @@ -6,10 +6,5 @@ SUBROUTINE abort_gcm(modname, message, ierr) -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin_dump - USE ioipsl_getincom -#endif !! ug Pour les sorties XIOS USE wxios @@ -36,8 +31,6 @@ ENDIF -#ifdef CPP_IOIPSL call histclo call restclo -#endif call getin_dump ! call histclo(2) Index: LMDZ6/trunk/libf/dyn3d/bilan_dyn.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/bilan_dyn.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/bilan_dyn.F90 (revision 5267) @@ -10,7 +10,5 @@ ! vQ..A=Cp T + L * ... -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE comconst_mod, ONLY: pi, cpp USE comvert_mod, ONLY: presnivs @@ -26,5 +24,5 @@ !==================================================================== ! - ! Sous-programme consacre à des diagnostics dynamiques de base + ! Sous-programme consacre � des diagnostics dynamiques de base ! ! @@ -89,5 +87,5 @@ real :: ww - ! variables dynamiques intermédiaires + ! variables dynamiques interm�diaires REAL :: vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm) REAL :: ang(iip1,jjp1,llm),unat(iip1,jjp1,llm) @@ -97,8 +95,8 @@ REAL :: bern(iip1,jjp1,llm) - ! champ contenant les scalaires advectés. + ! champ contenant les scalaires advect�s. real :: Q(iip1,jjp1,llm,nQ) - ! champs cumulés + ! champs cumul�s real :: ps_cum(iip1,jjp1) real :: masse_cum(iip1,jjp1,llm) @@ -308,10 +306,10 @@ ! ---------------------------- - ! énergie cinétique + ! �nergie cin�tique ucont(:,:,:)=0 CALL covcont(llm,ucov,vcov,ucont,vcont) CALL enercin(vcov,ucov,vcont,ucont,ecin) - ! moment cinétique + ! moment cin�tique do l=1,llm ang(:,:,l)=ucov(:,:,l)+constang(:,:) @@ -373,5 +371,5 @@ enddo - ! flux méridien + ! flux m�ridien ! ------------- do iQ=1,nQ @@ -440,5 +438,5 @@ !===================================================================== - ! Transport méridien + ! Transport m�ridien !===================================================================== Index: LMDZ6/trunk/libf/dyn3d/check_isotopes.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/check_isotopes.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/check_isotopes.F90 (revision 5267) @@ -4,9 +4,5 @@ ntiso, iH2O, nzone, tracers, isoName, itZonIso USE iso_params_mod, ONLY: tnat_H216O, tnat_H217O, tnat_H218O, tnat_HDO, tnat_HTO -#ifdef CPP_IOIPSL USE ioipsl, ONLY: getin -#else - USE ioipsl_getincom, ONLY: getin -#endif IMPLICIT NONE include "dimensions.h" Index: LMDZ6/trunk/libf/dyn3d/conf_gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/conf_gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/conf_gcm.F90 (revision 5267) @@ -5,10 +5,5 @@ USE control_mod -#ifdef CPP_IOIPSL use IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - use ioipsl_getincom -#endif USE infotrac, ONLY : type_trac use assert_m, only: assert Index: LMDZ6/trunk/libf/dyn3d/dynetat0.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/dynetat0.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/dynetat0.F90 (revision 5267) @@ -19,9 +19,5 @@ USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else - USE ioipsl_getincom, ONLY: getin -#endif USE iso_params_mod ! tnat_* and alpha_ideal_* USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS Index: LMDZ6/trunk/libf/dyn3d/dynredem.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/dynredem.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/dynredem.F90 (revision 5267) @@ -4,7 +4,5 @@ ! Write the NetCDF restart file (initialization). !------------------------------------------------------------------------------- -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE strings_mod, ONLY: maxlen USE infotrac, ONLY: nqtot, tracers @@ -46,13 +44,7 @@ !=============================================================================== modname='dynredem0'; fil=fichnom -#ifdef CPP_IOIPSL CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) -#else -! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used) - yyears0=0 - mmois0=1 - jjour0=1 -#endif + tab_cntrl(:) = 0. Index: LMDZ6/trunk/libf/dyn3d/fluxstokenc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/fluxstokenc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/fluxstokenc.F90 (revision 5267) @@ -4,5 +4,4 @@ SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis, & time_step,itau ) -#ifdef CPP_IOIPSL ! This routine is designed to work with ioipsl @@ -162,9 +161,6 @@ ENDIF ! if iadvtr.EQ.istdyn -#else - write(lunout,*) & - 'fluxstokenc: Needs IOIPSL to function' -#endif - ! of #ifdef CPP_IOIPSL + + RETURN END SUBROUTINE fluxstokenc Index: LMDZ6/trunk/libf/dyn3d/friction.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/friction.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/friction.F90 (revision 5267) @@ -6,10 +6,6 @@ USE control_mod -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + USE comconst_mod, ONLY: pi IMPLICIT NONE Index: LMDZ6/trunk/libf/dyn3d/gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/gcm.F90 (revision 5267) @@ -6,10 +6,6 @@ PROGRAM gcm -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + @@ -173,5 +169,4 @@ ! calend = 'earth_365d' -#ifdef CPP_IOIPSL if (calend == 'earth_360d') then call ioconf_calendar('360_day') @@ -187,5 +182,5 @@ call abort_gcm(modname,abort_message,1) endif -#endif + !----------------------------------------------------------------------- ! @@ -325,5 +320,4 @@ ! endif -#ifdef CPP_IOIPSL mois = 1 heure = 0. @@ -340,11 +334,5 @@ write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure' write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure -#else - ! Ehouarn: we still need to define JD_ref and JH_ref - ! and since we don't know how many days there are in a year - ! we set JD_ref to 0 (this should be improved ...) - jD_ref=0 - jH_ref=0 -#endif + @@ -391,5 +379,4 @@ 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//) -#ifdef CPP_IOIPSL call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure) write (lunout,301)jour, mois, an @@ -398,5 +385,5 @@ 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4) 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4) -#endif + !----------------------------------------------------------------------- @@ -423,10 +410,9 @@ ecripar = .TRUE. -#ifdef CPP_IOIPSL time_step = zdtvr if (ok_dyn_ins) then ! initialize output file for instantaneous outputs ! t_ops = iecri * daysec ! do operations every t_ops - t_ops =((1.0*iecri)/day_step) * daysec + t_ops =((1.0*iecri)/day_step) * daysec t_wrt = daysec ! iecri * daysec ! write output every t_wrt CALL inithist(day_ref,annee_ref,time_step, & @@ -434,5 +420,5 @@ endif - IF (ok_dyn_ave) THEN + IF (ok_dyn_ave) THEN ! initialize output file for averaged outputs t_ops = iperiod * time_step ! do operations every t_ops @@ -442,6 +428,5 @@ END IF dtav = iperiod*dtvr/daysec -#endif - ! #endif of #ifdef CPP_IOIPSL + ! Choix des frequences de stokage pour le offline Index: LMDZ6/trunk/libf/dyn3d/getparam.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/getparam.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/getparam.F90 (revision 5267) @@ -3,10 +3,6 @@ ! MODULE getparam -#ifdef CPP_IOIPSL USE IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + INTERFACE getpar Index: LMDZ6/trunk/libf/dyn3d/iniacademic.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/iniacademic.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/iniacademic.F90 (revision 5267) @@ -9,10 +9,6 @@ use exner_hyb_m, only: exner_hyb use exner_milieu_m, only: exner_milieu -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom, ONLY: getin -#endif + USE Write_Field USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm Index: LMDZ6/trunk/libf/dyn3d/leapfrog.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d/leapfrog.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d/leapfrog.F90 (revision 5267) @@ -8,7 +8,5 @@ !IM : pour sortir les param. du modele dans un fis. netcdf 110106 -#ifdef CPP_IOIPSL use IOIPSL -#endif USE infotrac, ONLY: nqtot, isoCheck USE guide_mod, ONLY : guide_main @@ -241,9 +239,8 @@ call check_isotopes_seq(q,ip1jmp1,'leapfrog 321') -#ifdef CPP_IOIPSL if (ok_guide) then call guide_main(itau,ucov,vcov,teta,q,masse,ps) endif -#endif + @@ -355,8 +352,7 @@ !maf stokage du flux de masse pour traceurs OFF-LINE -#ifdef CPP_IOIPSL CALL fluxstokenc(pbaru,pbarv,masse,teta,phi,phis, & dtvr, itau) -#endif + @@ -451,5 +447,5 @@ ENDIF ! of IF (ip_ebil_dyn.ge.1 ) !-jld -#ifdef CPP_IOIPSL + !IM decommenter les 6 lignes suivantes pour sortir quelques parametres dynamiques de LMDZ !IM uncomment next 6 lines to get some parameters for LMDZ dynamics @@ -460,7 +456,5 @@ ! !#include "write_paramLMDZ_dyn.h" - ! -#endif - ! #endif of #ifdef CPP_IOIPSL + IF (CPPKEY_PHYS) THEN CALL calfis( lafin , jD_cur, jH_cur, & @@ -675,14 +669,12 @@ IF (ok_dynzon) THEN -#ifdef CPP_IOIPSL CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav, & ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) -#endif + END IF IF (ok_dyn_ave) THEN -#ifdef CPP_IOIPSL CALL writedynav(itau,vcov, & ucov,teta,pk,phi,q,masse,ps,phis) -#endif + ENDIF @@ -704,5 +696,4 @@ vnat(:,l)=vcov(:,l)/cv(:) enddo -#ifdef CPP_IOIPSL if (ok_dyn_ins) then ! write(lunout,*) "leapfrog: call writehist, itau=",itau @@ -714,5 +705,5 @@ ! call WriteField('masse',reshape(masse,(/iip1,jmp1,llm/))) endif ! of if (ok_dyn_ins) -#endif + ! For some Grads outputs of fields if (output_grads_dyn) then @@ -812,14 +803,12 @@ IF (ok_dynzon) THEN -#ifdef CPP_IOIPSL CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav, & ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) -#endif + ENDIF IF (ok_dyn_ave) THEN -#ifdef CPP_IOIPSL CALL writedynav(itau,vcov, & ucov,teta,pk,phi,q,masse,ps,phis) -#endif + ENDIF @@ -834,5 +823,4 @@ vnat(:,l)=vcov(:,l)/cv(:) enddo -#ifdef CPP_IOIPSL if (ok_dyn_ins) then ! write(lunout,*) "leapfrog: call writehist (b)", @@ -840,5 +828,5 @@ CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) endif ! of if (ok_dyn_ins) -#endif + ! For some Grads outputs if (output_grads_dyn) then Index: LMDZ6/trunk/libf/dyn3d_common/conf_planete.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/conf_planete.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/conf_planete.F90 (revision 5267) @@ -4,10 +4,5 @@ SUBROUTINE conf_planete ! -#ifdef CPP_IOIPSL USE IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin -USE ioipsl_getincom -#endif USE comconst_mod, ONLY: pi, g, molmass, kappa, cpp, omeg, rad, & year_day, daylen, daysec, ihf Index: LMDZ6/trunk/libf/dyn3d_common/disvert.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/disvert.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/disvert.F90 (revision 5267) @@ -3,9 +3,5 @@ SUBROUTINE disvert() -#ifdef CPP_IOIPSL use ioipsl, only: getin -#else - USE ioipsl_getincom, only: getin -#endif use new_unit_m, only: new_unit use assert_m, only: assert Index: LMDZ6/trunk/libf/dyn3d_common/disvert_noterre.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/disvert_noterre.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/disvert_noterre.F90 (revision 5267) @@ -6,10 +6,6 @@ ! On l'utilise aussi pour Venus et Titan, legerment modifiee. -#ifdef CPP_IOIPSL use IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - use ioipsl_getincom -#endif + USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt, & nivsig,nivsigs,pa,preff,scaleheight @@ -24,5 +20,5 @@ ! !======================================================================= - ! Discretisation verticale en coordonnée hybride (ou sigma) + ! Discretisation verticale en coordonn�e hybride (ou sigma) ! !======================================================================= @@ -208,9 +204,9 @@ ! Calcul au milieu des couches : ! WARNING : le choix de placer le milieu des couches au niveau de - ! pression intermédiaire est arbitraire et pourrait etre modifié. + ! pression interm�diaire est arbitraire et pourrait etre modifi�. ! Le calcul du niveau pour la derniere couche ! (on met la meme distance (en log pression) entre P(llm) ! et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est - ! Specifique. Ce choix est spécifié ici ET dans exner_milieu.F + ! Specifique. Ce choix est sp�cifi� ici ET dans exner_milieu.F DO l = 1, llm-1 @@ -284,6 +280,6 @@ ! L'objectif est de calculer newsig telle que ! (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig - ! Cela ne se résoud pas analytiquement: - ! => on résoud par iterration bourrine + ! Cela ne se r�soud pas analytiquement: + ! => on r�soud par iterration bourrine ! ---------------------------------------------- ! Information : where exp(1-1./x**2) become << x @@ -320,5 +316,5 @@ newsig=(X2+newsig)*0.5 end if - ! Test : on arete lorsque on approxime sig à moins de 0.01 m près + ! Test : on arete lorsque on approxime sig � moins de 0.01 m pr�s ! (en pseudo altitude) : IF(abs(10.*log(F)).LT.1.E-5) goto 999 Index: LMDZ6/trunk/libf/dyn3d_common/iniconst.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/iniconst.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/iniconst.F90 (revision 5267) @@ -5,10 +5,6 @@ USE control_mod -#ifdef CPP_IOIPSL use IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - use ioipsl_getincom -#endif + USE comconst_mod, ONLY: im, imp1, jm, jmp1, lllm, lllmm1, lllmp1, & unsim, pi, r, kappa, cpp, dtvr, dtphys Index: LMDZ6/trunk/libf/dyn3d_common/initdynav.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/initdynav.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/initdynav.F90 (revision 5267) @@ -3,7 +3,5 @@ subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt) -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE infotrac, ONLY : nqtot use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid, & @@ -47,5 +45,4 @@ real tstep, t_ops, t_wrt -#ifdef CPP_IOIPSL ! This routine needs IOIPSL to work ! Variables locales @@ -82,5 +79,5 @@ ! Creation de 3 fichiers pour les differentes grilles horizontales ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier - ! Grille Scalaire + ! Grille Scalaire call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), & 1, iip1, 1, jjp1, & @@ -185,9 +182,6 @@ call histend(histuaveid) call histend(histvaveid) -#else - write(lunout,*)"initdynav: Warning this routine should not be", & - " used without ioipsl" -#endif - ! of #ifdef CPP_IOIPSL + + end subroutine initdynav Index: LMDZ6/trunk/libf/dyn3d_common/initfluxsto.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/initfluxsto.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/initfluxsto.F90 (revision 5267) @@ -6,7 +6,5 @@ fileid,filevid,filedid) -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE comconst_mod, ONLY: pi USE comvert_mod, ONLY: nivsigs @@ -54,5 +52,4 @@ integer :: fileid, filevid,filedid -#ifdef CPP_IOIPSL ! This routine needs IOIPSL to work ! Variables locales @@ -222,10 +219,6 @@ endif -#else - ! tell the user this routine should be run with ioipsl - write(lunout,*)"initfluxsto: Warning this routine should not be", & - " used without ioipsl" -#endif - ! of #ifdef CPP_IOIPSL + + return end subroutine initfluxsto Index: LMDZ6/trunk/libf/dyn3d_common/inithist.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/inithist.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/inithist.F90 (revision 5267) @@ -4,7 +4,5 @@ subroutine inithist(day0,anne0,tstep,t_ops,t_wrt) -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE infotrac, ONLY : nqtot use com_io_dyn_mod, only : histid,histvid,histuid, & @@ -52,5 +50,4 @@ real :: tstep, t_ops, t_wrt -#ifdef CPP_IOIPSL ! This routine needs IOIPSL to work ! Variables locales @@ -186,10 +183,6 @@ call histend(histuid) call histend(histvid) -#else - ! tell the user this routine should be run with ioipsl - write(lunout,*)"inithist: Warning this routine should not be", & - " used without ioipsl" -#endif - ! of #ifdef CPP_IOIPSL + + return end subroutine inithist Index: LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F90 (revision 5267) @@ -33,9 +33,5 @@ LOGICAL FUNCTION iso_verif_aberrant_nostop(x, iso, q, err_msg) RESULT(lerr) -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else - USE ioipsl_getincom, ONLY: getin -#endif USE iso_params_mod, ONLY: tnat_HDO IMPLICIT NONE Index: LMDZ6/trunk/libf/dyn3d_common/writedynav.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/writedynav.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/writedynav.F90 (revision 5267) @@ -3,7 +3,5 @@ subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis) -#ifdef CPP_IOIPSL USE ioipsl -#endif USE infotrac, ONLY : nqtot use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid @@ -46,5 +44,4 @@ integer time -#ifdef CPP_IOIPSL ! This routine needs IOIPSL to work ! Variables locales @@ -53,5 +50,5 @@ INTEGER iq, ii, ll real tm(ip1jmp1*llm) - REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) + REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) logical ok_sync integer itau_w @@ -75,5 +72,5 @@ ! Appels a histwrite pour l'ecriture des variables a sauvegarder - ! Vents U + ! Vents U call histwrite(histuaveid, 'u', itau_w, unat, & @@ -129,9 +126,6 @@ ENDIF -#else - write(lunout, *) "writedynav: Warning this routine should not be", & - " used without ioipsl" -#endif - ! of #ifdef CPP_IOIPSL + + end subroutine writedynav Index: LMDZ6/trunk/libf/dyn3d_common/writehist.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3d_common/writehist.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3d_common/writehist.F90 (revision 5267) @@ -4,7 +4,5 @@ subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis) -#ifdef CPP_IOIPSL USE ioipsl -#endif USE infotrac, ONLY : nqtot use com_io_dyn_mod, only : histid,histvid,histuid @@ -53,5 +51,4 @@ -#ifdef CPP_IOIPSL ! This routine needs IOIPSL to work ! Variables locales @@ -123,10 +120,6 @@ call histsync(histuid) endif -#else - ! tell the user this routine should be run with ioipsl - write(lunout,*)"writehist: Warning this routine should not be", & - " used without ioipsl" -#endif - ! of #ifdef CPP_IOIPSL + + return end subroutine writehist Index: LMDZ6/trunk/libf/dyn3dmem/abort_gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/abort_gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/abort_gcm.F90 (revision 5267) @@ -6,10 +6,6 @@ SUBROUTINE abort_gcm(modname, message, ierr) -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin_dump - USE ioipsl_getincom -#endif + USE parallel_lmdz INCLUDE "iniprint.h" @@ -28,5 +24,4 @@ write(lunout,*) 'in abort_gcm' -#ifdef CPP_IOIPSL !$OMP MASTER call histclo @@ -36,5 +31,4 @@ endif !$OMP END MASTER -#endif ! call histclo(2) ! call histclo(3) Index: LMDZ6/trunk/libf/dyn3dmem/bilan_dyn_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/bilan_dyn_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/bilan_dyn_loc.F90 (revision 5267) @@ -10,7 +10,5 @@ ! vQ..A=Cp T + L * ... -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE parallel_lmdz USE mod_hallo @@ -30,5 +28,5 @@ !==================================================================== ! - ! Sous-programme consacre à des diagnostics dynamiques de base + ! Sous-programme consacre � des diagnostics dynamiques de base ! ! @@ -88,5 +86,5 @@ real :: ww - ! variables dynamiques intermédiaires + ! variables dynamiques interm�diaires REAL,SAVE,ALLOCATABLE :: vcont(:,:,:),ucont(:,:,:) REAL,SAVE,ALLOCATABLE :: ang(:,:,:),unat(:,:,:) @@ -96,8 +94,8 @@ REAL,SAVE,ALLOCATABLE :: bern(:,:,:) - ! champ contenant les scalaires advectés. + ! champ contenant les scalaires advect�s. real,SAVE,ALLOCATABLE :: Q(:,:,:,:) - ! champs cumulés + ! champs cumul�s real,SAVE,ALLOCATABLE :: ps_cum(:,:) real,SAVE,ALLOCATABLE :: masse_cum(:,:,:) @@ -370,5 +368,5 @@ jje=jj_end - ! énergie cinétique + ! �nergie cin�tique ! ucont(:,jjb:jje,:)=0 @@ -382,5 +380,5 @@ CALL enercin_loc(vcov,ucov,vcont,ucont,ecin) - ! moment cinétique + ! moment cin�tique !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm @@ -490,5 +488,5 @@ enddo - ! flux méridien + ! flux m�ridien ! ------------- do iQ=1,nQ @@ -642,5 +640,5 @@ !===================================================================== - ! Transport méridien + ! Transport m�ridien !===================================================================== Index: LMDZ6/trunk/libf/dyn3dmem/check_isotopes_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/check_isotopes_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/check_isotopes_loc.F90 (revision 5267) @@ -5,9 +5,5 @@ ntiso, iH2O, nzone, tracers, isoName, itZonIso USE iso_params_mod, ONLY: tnat_H216O, tnat_H217O, tnat_H218O, tnat_HDO, tnat_HTO -#ifdef CPP_IOIPSL USE ioipsl, ONLY: getin -#else - USE ioipsl_getincom, ONLY: getin -#endif IMPLICIT NONE include "dimensions.h" Index: LMDZ6/trunk/libf/dyn3dmem/conf_gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/conf_gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/conf_gcm.F90 (revision 5267) @@ -5,10 +5,6 @@ USE control_mod -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + USE misc_mod USE mod_filtre_fft, ONLY: use_filtre_fft @@ -121,7 +117,7 @@ !Config Key = prt_level - !Config Desc = niveau d'impressions de débogage + !Config Desc = niveau d'impressions de d�bogage !Config Def = 0 - !Config Help = Niveau d'impression pour le débogage + !Config Help = Niveau d'impression pour le d�bogage !Config (0 = minimum d'impression) prt_level = 0 @@ -921,9 +917,9 @@ !Config Key = use_mpi_alloc - !Config Desc = Utilise un buffer MPI en m�moire globale + !Config Desc = Utilise un buffer MPI en m�moire globale !Config Def = false !Config Help = permet d'activer l'utilisation d'un buffer MPI - !Config en m�moire globale a l'aide de la fonction MPI_ALLOC. - !Config Cela peut am�liorer la bande passante des transferts MPI + !Config en m�moire globale a l'aide de la fonction MPI_ALLOC. + !Config Cela peut am�liorer la bande passante des transferts MPI !Config d'un facteur 2 use_mpi_alloc=.FALSE. @@ -933,5 +929,5 @@ !Config Desc = activation de la version strato !Config Def = .FALSE. - !Config Help = active la version stratosphérique de LMDZ de F. Lott + !Config Help = active la version stratosph�rique de LMDZ de F. Lott ok_strato=.FALSE. Index: LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90 (revision 5267) @@ -20,9 +20,5 @@ USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else - USE ioipsl_getincom, ONLY: getin -#endif USE iso_params_mod ! tnat_* and alpha_ideal_* USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS Index: LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90 (revision 5267) @@ -4,7 +4,5 @@ ! Write the NetCDF restart file (initialization). !------------------------------------------------------------------------------- -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE parallel_lmdz USE mod_hallo @@ -53,13 +51,7 @@ IF(mpi_rank/=0) RETURN -#ifdef CPP_IOIPSL CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian) CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours) -#else -! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used) - yyears0=0 - mmois0=1 - jjour0=1 -#endif + tab_cntrl(:) = 0. Index: LMDZ6/trunk/libf/dyn3dmem/friction_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/friction_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/friction_loc.F90 (revision 5267) @@ -6,10 +6,6 @@ USE parallel_lmdz USE control_mod -#ifdef CPP_IOIPSL USE IOIPSL -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + USE comconst_mod, ONLY: pi IMPLICIT NONE Index: LMDZ6/trunk/libf/dyn3dmem/gcm.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/gcm.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/gcm.F90 (revision 5267) @@ -5,7 +5,5 @@ PROGRAM gcm -#ifdef CPP_IOIPSL USE IOIPSL -#endif USE mod_const_mpi, ONLY: init_const_mpi @@ -178,5 +176,4 @@ ! calend = 'earth_365d' -#ifdef CPP_IOIPSL if (calend == 'earth_360d') then call ioconf_calendar('360_day') @@ -195,5 +192,5 @@ call abort_gcm(modname,abort_message,1) endif -#endif + @@ -330,5 +327,4 @@ ! endif -#ifdef CPP_IOIPSL mois = 1 heure = 0. @@ -345,11 +341,5 @@ write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure' write(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref -#else - ! Ehouarn: we still need to define JD_ref and JH_ref - ! and since we don't know how many days there are in a year - ! we set JD_ref to 0 (this should be improved ...) - jD_ref=0 - jH_ref=0 -#endif + if (iflag_phys.eq.1) then @@ -394,5 +384,4 @@ 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//) -#ifdef CPP_IOIPSL call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure) write (lunout,301)jour, mois, an @@ -401,5 +390,5 @@ 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4) 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4) -#endif + !----------------------------------------------------------------------- @@ -433,10 +422,9 @@ #define CPP_IOIPSL -#ifdef CPP_IOIPSL time_step = zdtvr if (ok_dyn_ins) then ! initialize output file for instantaneous outputs ! t_ops = iecri * daysec ! do operations every t_ops - t_ops =((1.0*iecri)/day_step) * daysec + t_ops =((1.0*iecri)/day_step) * daysec t_wrt = daysec ! iecri * daysec ! write output every t_wrt CALL inithist_loc(day_ref,annee_ref,time_step, & @@ -444,5 +432,5 @@ endif - IF (ok_dyn_ave) THEN + IF (ok_dyn_ave) THEN ! initialize output file for averaged outputs t_ops = iperiod * time_step ! do operations every t_ops @@ -451,6 +439,4 @@ END IF dtav = iperiod*dtvr/daysec -#endif -#undef CPP_IOIPSL ! setting up DYN3D/XIOS inerface @@ -460,5 +446,4 @@ endif - ! #endif of #ifdef CPP_IOIPSL ! !----------------------------------------------------------------------- Index: LMDZ6/trunk/libf/dyn3dmem/getparam.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/getparam.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/getparam.F90 (revision 5267) @@ -3,10 +3,6 @@ ! MODULE getparam -#ifdef CPP_IOIPSL USE IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom -#endif + INTERFACE getpar Index: LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90 (revision 5267) @@ -10,10 +10,6 @@ use exner_milieu_m, only: exner_milieu USE parallel_lmdz, ONLY: ijb_u, ije_u, ijb_v, ije_v -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else - ! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom, ONLY: getin -#endif + USE Write_Field USE comconst_mod, ONLY: cpp, kappa, g, daysec, dtvr, pi, im, jm Index: LMDZ6/trunk/libf/dyn3dmem/initdynav_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/initdynav_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/initdynav_loc.F90 (revision 5267) @@ -4,8 +4,7 @@ subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt) -#ifdef CPP_IOIPSL ! This routine needs IOIPSL USE IOIPSL -#endif + USE parallel_lmdz use Write_field @@ -56,5 +55,4 @@ real :: tstep, t_ops, t_wrt -#ifdef CPP_IOIPSL ! This routine needs IOIPSL ! Variables locales @@ -281,7 +279,4 @@ call histend(histuaveid) call histend(histvaveid) -#else - write(lunout,*)'initdynav_loc: Needs IOIPSL to function' -#endif - ! #endif of #ifdef CPP_IOIPSL + end subroutine initdynav_loc Index: LMDZ6/trunk/libf/dyn3dmem/initfluxsto_p.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/initfluxsto_p.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/initfluxsto_p.F90 (revision 5267) @@ -6,8 +6,7 @@ fileid,filevid,filedid) -#ifdef CPP_IOIPSL ! This routine needs IOIPSL USE IOIPSL -#endif + USE parallel_lmdz use Write_field @@ -58,5 +57,4 @@ integer :: fileid, filevid,filedid -#ifdef CPP_IOIPSL ! This routine needs IOIPSL ! Variables locales @@ -287,8 +285,5 @@ endif -#else - write(lunout,*)'initfluxsto_p: Needs IOIPSL to function' -#endif - ! #endif of #ifdef CPP_IOIPSL + return end subroutine initfluxsto_p Index: LMDZ6/trunk/libf/dyn3dmem/inithist_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/inithist_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/inithist_loc.F90 (revision 5267) @@ -4,8 +4,7 @@ subroutine inithist_loc(day0,anne0,tstep,t_ops,t_wrt) -#ifdef CPP_IOIPSL ! This routine needs IOIPSL USE IOIPSL -#endif + USE parallel_lmdz use Write_field @@ -54,5 +53,4 @@ real :: tstep, t_ops, t_wrt -#ifdef CPP_IOIPSL ! This routine needs IOIPSL ! Variables locales @@ -281,7 +279,4 @@ call histend(histuid) call histend(histvid) -#else - write(lunout,*)'inithist_loc: Needs IOIPSL to function' -#endif - ! #endif of #ifdef CPP_IOIPSL + end subroutine inithist_loc Index: LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F90 (revision 5267) @@ -317,10 +317,9 @@ call check_isotopes(q,ijb_u,ije_u,'leapfrog 321') -#ifdef CPP_IOIPSL if (ok_guide) then call guide_main(itau,ucov,vcov,teta,q,masse,ps) !$OMP BARRIER endif -#endif + @@ -1610,5 +1609,4 @@ !$OMP BARRIER -#ifdef CPP_IOIPSL IF (ok_dynzon) THEN @@ -1622,5 +1620,5 @@ ucov,teta,pk,phi,q,masse,ps,phis) ENDIF -#endif + @@ -1643,10 +1641,9 @@ !$OMP BARRIER -#ifdef CPP_IOIPSL if (ok_dyn_ins) then CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & masse,ps,phis) endif -#endif + IF (ok_dyn_xios) THEN @@ -1779,5 +1776,4 @@ ENDIF -#ifdef CPP_IOIPSL ! ! Ehouarn: re-compute geopotential for outputs !$OMP BARRIER @@ -1796,5 +1792,5 @@ ucov,teta,pk,phi,q,masse,ps,phis) ENDIF -#endif + @@ -1811,10 +1807,9 @@ -#ifdef CPP_IOIPSL if (ok_dyn_ins) then CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q, & masse,ps,phis) endif ! of if (ok_dyn_ins) -#endif + IF (ok_dyn_xios) THEN Index: LMDZ6/trunk/libf/dyn3dmem/mod_const_mpi.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/mod_const_mpi.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/mod_const_mpi.F90 (revision 5267) @@ -13,10 +13,6 @@ USE lmdz_mpi -#ifdef CPP_IOIPSL USE IOIPSL, ONLY: getin -#else -! if not using IOIPSL, we still need to use (a local version of) getin - USE ioipsl_getincom, only: getin -#endif + ! Use of Oasis-MCT coupler #ifdef CPP_OMCT Index: LMDZ6/trunk/libf/dyn3dmem/parallel_lmdz.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/parallel_lmdz.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/parallel_lmdz.F90 (revision 5267) @@ -5,10 +5,6 @@ USE mod_const_mpi USE lmdz_mpi, ONLY : using_mpi -#ifdef CPP_IOIPSL use IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin - use ioipsl_getincom -#endif + INTEGER,PARAMETER :: halo_max=3 Index: LMDZ6/trunk/libf/dyn3dmem/writedynav_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/writedynav_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/writedynav_loc.F90 (revision 5267) @@ -5,8 +5,7 @@ masse,ps,phis) -#ifdef CPP_IOIPSL ! This routine needs IOIPSL USE ioipsl -#endif + USE parallel_lmdz USE misc_mod @@ -63,5 +62,4 @@ -#ifdef CPP_IOIPSL ! This routine needs IOIPSL ! Variables locales @@ -219,7 +217,4 @@ ENDIF !$OMP END MASTER -#else - write(lunout,*)'writedynav_loc: Needs IOIPSL to function' -#endif - ! #endif of #ifdef CPP_IOIPSL + end subroutine writedynav_loc Index: LMDZ6/trunk/libf/dyn3dmem/writehist_loc.F90 =================================================================== --- LMDZ6/trunk/libf/dyn3dmem/writehist_loc.F90 (revision 5266) +++ LMDZ6/trunk/libf/dyn3dmem/writehist_loc.F90 (revision 5267) @@ -5,8 +5,7 @@ masse,ps,phis) -#ifdef CPP_IOIPSL ! This routine needs IOIPSL USE ioipsl -#endif + USE parallel_lmdz USE misc_mod @@ -63,5 +62,4 @@ -#ifdef CPP_IOIPSL ! This routine needs IOIPSL ! Variables locales @@ -218,7 +216,4 @@ endif !$OMP END MASTER -#else - write(lunout,*)'writehist_loc: Needs IOIPSL to function' -#endif - ! #endif of #ifdef CPP_IOIPSL + end subroutine writehist_loc Index: LMDZ6/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90 =================================================================== --- LMDZ6/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90 (revision 5266) +++ LMDZ6/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90 (revision 5267) @@ -101,5 +101,4 @@ !--- Calendar choice -#ifdef CPP_IOIPSL calnd='gregorian' SELECT CASE(calend) @@ -116,5 +115,5 @@ END SELECT WRITE(lunout,*)'CHOSEN CALENDAR: Earth '//TRIM(calnd) -#endif + #ifdef CPP_PARA Index: LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 =================================================================== --- LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 (revision 5266) +++ LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90 (revision 5267) @@ -96,5 +96,5 @@ USE phys_state_var_mod, ONLY: beta_aridity, delta_tsurf, awake_dens, cv_gen, & ratqs_inter_ - !use ioipsl_getincom + !use ioipsl IMPLICIT NONE !------------------------------------------------------------------------------- Index: LMDZ6/trunk/libf/misc/ioipsl_errioipsl.F90 =================================================================== --- LMDZ6/trunk/libf/misc/ioipsl_errioipsl.F90 (revision 5266) +++ (revision ) @@ -1,219 +1,0 @@ -! -! $Id$ -! -! Module/Routines extracted from IOIPSL v2_1_8 -! -MODULE ioipsl_errioipsl -!- -!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $ -!- -! This software is governed by the CeCILL license -! See IOIPSL/IOIPSL_License_CeCILL.txt -!--------------------------------------------------------------------- -IMPLICIT NONE -!- -PRIVATE -!- -PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg -!- - INTEGER :: n_l=6, ilv_cur=0, ilv_max=0 - LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE. -!- -!=== -CONTAINS -!=== -SUBROUTINE ipslnlf (new_number,old_number) -!!-------------------------------------------------------------------- -!! The "ipslnlf" routine allows to know and modify -!! the current logical number for the messages. -!! -!! SUBROUTINE ipslnlf (new_number,old_number) -!! -!! Optional INPUT argument -!! -!! (I) new_number : new logical number of the file -!! -!! Optional OUTPUT argument -!! -!! (I) old_number : current logical number of the file -!!-------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER,OPTIONAL,INTENT(IN) :: new_number - INTEGER,OPTIONAL,INTENT(OUT) :: old_number -!--------------------------------------------------------------------- - IF (PRESENT(old_number)) THEN - old_number = n_l - ENDIF - IF (PRESENT(new_number)) THEN - n_l = new_number - ENDIF -!--------------------- -END SUBROUTINE ipslnlf -!=== -SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3) -!--------------------------------------------------------------------- -!! The "ipslerr" routine -!! allows to handle the messages to the user. -!! -!! INPUT -!! -!! plev : Category of message to be reported to the user -!! 1 = Note to the user -!! 2 = Warning to the user -!! 3 = Fatal error -!! pcname : Name of subroutine which has called ipslerr -!! pstr1 -!! pstr2 : Strings containing the explanations to the user -!! pstr3 -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: plev - CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 -!- - CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & - & (/ "NOTE TO THE USER FROM ROUTINE ", & - & "WARNING FROM ROUTINE ", & - & "FATAL ERROR FROM ROUTINE " /) -!--------------------------------------------------------------------- - IF ( (plev >= 1).AND.(plev <= 3) ) THEN - ilv_cur = plev - ilv_max = MAX(ilv_max,plev) - WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) - WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3) - ENDIF - IF ( (plev == 3).AND.lact_mode) THEN - STOP 'Fatal error from IOIPSL. See stdout for more details' - ENDIF -!--------------------- -END SUBROUTINE ipslerr -!=== -SUBROUTINE ipslerr_act (new_mode,old_mode) -!!-------------------------------------------------------------------- -!! The "ipslerr_act" routine allows to know and modify -!! the current "action mode" for the error messages, -!! and reinitialize the error level values. -!! -!! SUBROUTINE ipslerr_act (new_mode,old_mode) -!! -!! Optional INPUT argument -!! -!! (I) new_mode : new error action mode -!! .TRUE. -> STOP in case of fatal error -!! .FALSE. -> CONTINUE in case of fatal error -!! -!! Optional OUTPUT argument -!! -!! (I) old_mode : current error action mode -!!-------------------------------------------------------------------- - IMPLICIT NONE -!- - LOGICAL,OPTIONAL,INTENT(IN) :: new_mode - LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode -!--------------------------------------------------------------------- - IF (PRESENT(old_mode)) THEN - old_mode = lact_mode - ENDIF - IF (PRESENT(new_mode)) THEN - lact_mode = new_mode - ENDIF - ilv_cur = 0 - ilv_max = 0 -!------------------------- -END SUBROUTINE ipslerr_act -!=== -SUBROUTINE ipslerr_inq (current_level,maximum_level) -!!-------------------------------------------------------------------- -!! The "ipslerr_inq" routine allows to know -!! the current level of the error messages -!! and the maximum level encountered since the -!! last call to "ipslerr_act". -!! -!! SUBROUTINE ipslerr_inq (current_level,maximum_level) -!! -!! Optional OUTPUT argument -!! -!! (I) current_level : current error level -!! (I) maximum_level : maximum error level -!!-------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level -!--------------------------------------------------------------------- - IF (PRESENT(current_level)) THEN - current_level = ilv_cur - ENDIF - IF (PRESENT(maximum_level)) THEN - maximum_level = ilv_max - ENDIF -!------------------------- -END SUBROUTINE ipslerr_inq -!=== -SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3) -!--------------------------------------------------------------------- -!- INPUT -!- plev : Category of message to be reported to the user -!- 1 = Note to the user -!- 2 = Warning to the user -!- 3 = Fatal error -!- pcname : Name of subroutine which has called histerr -!- pstr1 -!- pstr2 : String containing the explanations to the user -!- pstr3 -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: plev - CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3 -!- - CHARACTER(LEN=30),DIMENSION(3) :: pemsg = & - & (/ "NOTE TO THE USER FROM ROUTINE ", & - & "WARNING FROM ROUTINE ", & - & "FATAL ERROR FROM ROUTINE " /) -!--------------------------------------------------------------------- - IF ( (plev >= 1).AND.(plev <= 3) ) THEN - WRITE(*,'(" ")') - WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) - WRITE(*,'(" --> ",A)') pstr1 - WRITE(*,'(" --> ",A)') pstr2 - WRITE(*,'(" --> ",A)') pstr3 - ENDIF - IF (plev == 3) THEN - STOP 'Fatal error from IOIPSL. See stdout for more details' - ENDIF -!--------------------- -END SUBROUTINE histerr -!=== -SUBROUTINE ipsldbg (new_status,old_status) -!!-------------------------------------------------------------------- -!! The "ipsldbg" routine -!! allows to activate or deactivate the debug, -!! and to know the current status of the debug. -!! -!! SUBROUTINE ipsldbg (new_status,old_status) -!! -!! Optional INPUT argument -!! -!! (L) new_status : new status of the debug -!! -!! Optional OUTPUT argument -!! -!! (L) old_status : current status of the debug -!!-------------------------------------------------------------------- - IMPLICIT NONE -!- - LOGICAL,OPTIONAL,INTENT(IN) :: new_status - LOGICAL,OPTIONAL,INTENT(OUT) :: old_status -!--------------------------------------------------------------------- - IF (PRESENT(old_status)) THEN - old_status = ioipsl_debug - ENDIF - IF (PRESENT(new_status)) THEN - ioipsl_debug = new_status - ENDIF -!--------------------- -END SUBROUTINE ipsldbg -!=== -!------------------- -END MODULE ioipsl_errioipsl Index: LMDZ6/trunk/libf/misc/ioipsl_getincom.F90 =================================================================== --- LMDZ6/trunk/libf/misc/ioipsl_getincom.F90 (revision 5266) +++ (revision ) @@ -1,1980 +1,0 @@ -! -! $Id$ -! -! Module/Routines extracted from IOIPSL v2_1_8 -! -MODULE ioipsl_getincom -!- -!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $ -!- -! This software is governed by the CeCILL license -! See IOIPSL/IOIPSL_License_CeCILL.txt -!--------------------------------------------------------------------- -USE ioipsl_errioipsl, ONLY : ipslerr -USE ioipsl_stringop, & - & ONLY : nocomma,cmpblank,strlowercase -!- -IMPLICIT NONE -!- -PRIVATE -PUBLIC :: getin, getin_dump -!- -INTERFACE getin -!!-------------------------------------------------------------------- -!! The "getin" routines get a variable. -!! We first check if we find it in the database -!! and if not we get it from the run.def file. -!! -!! SUBROUTINE getin (target,ret_val) -!! -!! INPUT -!! -!! (C) target : Name of the variable -!! -!! OUTPUT -!! -!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain -!! that will contain the (standard) -!! integer/real/character/logical values -!!-------------------------------------------------------------------- - MODULE PROCEDURE getinrs, getinr1d, getinr2d, & - & getinis, getini1d, getini2d, & - & getincs, getinc1d, getinc2d, & - & getinls, getinl1d, getinl2d -END INTERFACE -!- -!!-------------------------------------------------------------------- -!! The "getin_dump" routine will dump the content of the database -!! into a file which has the same format as the run.def file. -!! The idea is that the user can see which parameters were used -!! and re-use the file for another run. -!! -!! SUBROUTINE getin_dump (fileprefix) -!! -!! OPTIONAL INPUT argument -!! -!! (C) fileprefix : allows the user to change the name of the file -!! in which the data will be archived -!!-------------------------------------------------------------------- -!- - INTEGER,PARAMETER :: max_files=100 - CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist - INTEGER,SAVE :: nbfiles -!- - INTEGER,PARAMETER :: i_txtslab=1000,l_n=30 - INTEGER,SAVE :: nb_lines,i_txtsize=0 - CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier - CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline -!- - INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15 - CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)' -!- -! The data base of parameters -!- - INTEGER,PARAMETER :: memslabs=200 - INTEGER,PARAMETER :: compress_lim=20 -!- - INTEGER,SAVE :: nb_keys=0 - INTEGER,SAVE :: keymemsize=0 -!- -! keystr definition -! name of a key -!- -! keystatus definition -! keystatus = 1 : Value comes from run.def -! keystatus = 2 : Default value is used -! keystatus = 3 : Some vector elements were taken from default -!- -! keytype definition -! keytype = 1 : Integer -! keytype = 2 : Real -! keytype = 3 : Character -! keytype = 4 : Logical -!- - INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4 -!- -! Allow compression for keys (only for integer and real) -! keycompress < 0 : not compressed -! keycompress > 0 : number of repeat of the value -!- -TYPE :: t_key - CHARACTER(LEN=l_n) :: keystr - INTEGER :: keystatus, keytype, keycompress, & - & keyfromfile, keymemstart, keymemlen -END TYPE t_key -!- - TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab -!- - INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem - INTEGER,SAVE :: i_memsize=0, i_mempos=0 - REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem - INTEGER,SAVE :: r_memsize=0, r_mempos=0 - CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem - INTEGER,SAVE :: c_memsize=0, c_mempos=0 - LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem - INTEGER,SAVE :: l_memsize=0, l_mempos=0 -!- -CONTAINS -!- -!=== INTEGER INTERFACE -!- -SUBROUTINE getinis (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - INTEGER :: ret_val -!- - INTEGER,DIMENSION(1) :: tmp_ret_val - INTEGER :: pos,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - tmp_ret_val(1) = ret_val -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,1,i_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,1,target,i_val=tmp_ret_val) - ENDIF - ret_val = tmp_ret_val(1) -!--------------------- -END SUBROUTINE getinis -!=== -SUBROUTINE getini1d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - INTEGER,DIMENSION(:) :: ret_val -!- - INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF - tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,i_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) - ENDIF - ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) -!---------------------- -END SUBROUTINE getini1d -!=== -SUBROUTINE getini2d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - INTEGER,DIMENSION(:,:) :: ret_val -!- - INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig - INTEGER :: jl,jj,ji -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - size_1 = SIZE(ret_val,1) - size_2 = SIZE(ret_val,2) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - tmp_ret_val(jl) = ret_val(ji,jj) - ENDDO - ENDDO -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,i_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - ret_val(ji,jj) = tmp_ret_val(jl) - ENDDO - ENDDO -!---------------------- -END SUBROUTINE getini2d -!- -!=== REAL INTERFACE -!- -SUBROUTINE getinrs (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - REAL :: ret_val -!- - REAL,DIMENSION(1) :: tmp_ret_val - INTEGER :: pos,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - tmp_ret_val(1) = ret_val -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,1,r_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,1,target,r_val=tmp_ret_val) - ENDIF - ret_val = tmp_ret_val(1) -!--------------------- -END SUBROUTINE getinrs -!=== -SUBROUTINE getinr1d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - REAL,DIMENSION(:) :: ret_val -!- - REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF - tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,r_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) - ENDIF - ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) -!---------------------- -END SUBROUTINE getinr1d -!=== -SUBROUTINE getinr2d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - REAL,DIMENSION(:,:) :: ret_val -!- - REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig - INTEGER :: jl,jj,ji -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - size_1 = SIZE(ret_val,1) - size_2 = SIZE(ret_val,2) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - tmp_ret_val(jl) = ret_val(ji,jj) - ENDDO - ENDDO -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,r_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - ret_val(ji,jj) = tmp_ret_val(jl) - ENDDO - ENDDO -!---------------------- -END SUBROUTINE getinr2d -!- -!=== CHARACTER INTERFACE -!- -SUBROUTINE getincs (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - CHARACTER(LEN=*) :: ret_val -!- - CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val - INTEGER :: pos,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - tmp_ret_val(1) = ret_val -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,1,c_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,1,target,c_val=tmp_ret_val) - ENDIF - ret_val = tmp_ret_val(1) -!--------------------- -END SUBROUTINE getincs -!=== -SUBROUTINE getinc1d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - CHARACTER(LEN=*),DIMENSION(:) :: ret_val -!- - CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF - tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,c_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) - ENDIF - ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) -!---------------------- -END SUBROUTINE getinc1d -!=== -SUBROUTINE getinc2d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val -!- - CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig - INTEGER :: jl,jj,ji -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - size_1 = SIZE(ret_val,1) - size_2 = SIZE(ret_val,2) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - tmp_ret_val(jl) = ret_val(ji,jj) - ENDDO - ENDDO -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,c_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - ret_val(ji,jj) = tmp_ret_val(jl) - ENDDO - ENDDO -!---------------------- -END SUBROUTINE getinc2d -!- -!=== LOGICAL INTERFACE -!- -SUBROUTINE getinls (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - LOGICAL :: ret_val -!- - LOGICAL,DIMENSION(1) :: tmp_ret_val - INTEGER :: pos,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - tmp_ret_val(1) = ret_val -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,1,l_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,1,target,l_val=tmp_ret_val) - ENDIF - ret_val = tmp_ret_val(1) -!--------------------- -END SUBROUTINE getinls -!=== -SUBROUTINE getinl1d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - LOGICAL,DIMENSION(:) :: ret_val -!- - LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,status=0,fileorig -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF - tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,l_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) - ENDIF - ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) -!---------------------- -END SUBROUTINE getinl1d -!=== -SUBROUTINE getinl2d (target,ret_val) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - LOGICAL,DIMENSION(:,:) :: ret_val -!- - LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val - INTEGER,SAVE :: tmp_ret_size = 0 - INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig - INTEGER :: jl,jj,ji -!--------------------------------------------------------------------- -!- -! Do we have this target in our database ? -!- - CALL get_findkey (1,target,pos) -!- - size_of_in = SIZE(ret_val) - size_1 = SIZE(ret_val,1) - size_2 = SIZE(ret_val,2) - IF (.NOT.ALLOCATED(tmp_ret_val)) THEN - ALLOCATE (tmp_ret_val(size_of_in)) - ELSE IF (size_of_in > tmp_ret_size) THEN - DEALLOCATE (tmp_ret_val) - ALLOCATE (tmp_ret_val(size_of_in)) - tmp_ret_size = size_of_in - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - tmp_ret_val(jl) = ret_val(ji,jj) - ENDDO - ENDDO -!- - IF (pos < 0) THEN -!-- Get the information out of the file - CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) -!-- Put the data into the database - CALL get_wdb & - & (target,status,fileorig,size_of_in,l_val=tmp_ret_val) - ELSE -!-- Get the value out of the database - CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) - ENDIF -!- - jl=0 - DO jj=1,size_2 - DO ji=1,size_1 - jl=jl+1 - ret_val(ji,jj) = tmp_ret_val(jl) - ENDDO - ENDDO -!---------------------- -END SUBROUTINE getinl2d -!- -!=== Generic file/database INTERFACE -!- -SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val) -!--------------------------------------------------------------------- -!- Subroutine that will extract from the file the values -!- attributed to the keyword target -!- -!- (C) target : target for which we will look in the file -!- (I) status : tells us from where we obtained the data -!- (I) fileorig : index of the file from which the key comes -!- (I) i_val(:) : INTEGER(nb_to_ret) values -!- (R) r_val(:) : REAL(nb_to_ret) values -!- (L) l_val(:) : LOGICAL(nb_to_ret) values -!- (C) c_val(:) : CHARACTER(nb_to_ret) values -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - INTEGER,INTENT(OUT) :: status,fileorig - INTEGER,DIMENSION(:),OPTIONAL :: i_val - REAL,DIMENSION(:),OPTIONAL :: r_val - LOGICAL,DIMENSION(:),OPTIONAL :: l_val - CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val -!- - INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err - CHARACTER(LEN=n_d_fmt) :: cnt - CHARACTER(LEN=80) :: str_READ,str_READ_lower - CHARACTER(LEN=9) :: c_vtyp - LOGICAL,DIMENSION(:),ALLOCATABLE :: found - LOGICAL :: def_beha,compressed - CHARACTER(LEN=10) :: c_fmt - INTEGER :: i_cmpval - REAL :: r_cmpval - INTEGER :: ipos_tr,ipos_fl -!--------------------------------------------------------------------- -!- -! Get the type of the argument - CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) - SELECT CASE (k_typ) - CASE(k_i) - nb_to_ret = SIZE(i_val) - CASE(k_r) - nb_to_ret = SIZE(r_val) - CASE(k_c) - nb_to_ret = SIZE(c_val) - CASE(k_l) - nb_to_ret = SIZE(l_val) - CASE DEFAULT - CALL ipslerr (3,'get_fil', & - & 'Internal error','Unknown type of data',' ') - END SELECT -!- -! Read the file(s) - CALL getin_read -!- -! Allocate and initialize the memory we need - ALLOCATE(found(nb_to_ret)) - found(:) = .FALSE. -!- -! See what we find in the files read - DO it=1,nb_to_ret -!--- -!-- First try the target as it is - CALL get_findkey (2,target,pos) -!--- -!-- Another try -!--- - IF (pos < 0) THEN - WRITE(UNIT=cnt,FMT=c_i_fmt) it - CALL get_findkey (2,TRIM(target)//'__'//cnt,pos) - ENDIF -!--- -!-- We dont know from which file the target could come. -!-- Thus by default we attribute it to the first file : - fileorig = 1 -!--- - IF (pos > 0) THEN -!----- - found(it) = .TRUE. - fileorig = fromfile(pos) -!----- -!---- DECODE -!----- - str_READ = ADJUSTL(fichier(pos)) - str_READ_lower = str_READ - CALL strlowercase (str_READ_lower) -!----- - IF ( (TRIM(str_READ_lower) == 'def') & - & .OR.(TRIM(str_READ_lower) == 'default') ) THEN - def_beha = .TRUE. - ELSE - def_beha = .FALSE. - len_str = LEN_TRIM(str_READ) - io_err = 0 - SELECT CASE (k_typ) - CASE(k_i) - WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str - READ (UNIT=str_READ(1:len_str), & - & FMT=c_fmt,IOSTAT=io_err) i_val(it) - CASE(k_r) - READ (UNIT=str_READ(1:len_str), & - & FMT=*,IOSTAT=io_err) r_val(it) - CASE(k_c) - c_val(it) = str_READ(1:len_str) - CASE(k_l) - ipos_tr = -1 - ipos_fl = -1 - ipos_tr = MAX(INDEX(str_READ_lower,'tru'), & - & INDEX(str_READ_lower,'y')) - ipos_fl = MAX(INDEX(str_READ_lower,'fal'), & - & INDEX(str_READ_lower,'n')) - IF (ipos_tr > 0) THEN - l_val(it) = .TRUE. - ELSE IF (ipos_fl > 0) THEN - l_val(it) = .FALSE. - ELSE - io_err = 100 - ENDIF - END SELECT - IF (io_err /= 0) THEN - CALL ipslerr (3,'get_fil', & - & 'Target '//TRIM(target), & - & 'is not of '//TRIM(c_vtyp)//' type',' ') - ENDIF - ENDIF -!----- - IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN -!------- -!------ Is this the value of a compressed field ? - compressed = (compline(pos) > 0) - IF (compressed) THEN - IF (compline(pos) /= nb_to_ret) THEN - CALL ipslerr (2,'get_fil', & - & 'For key '//TRIM(target)//' we have a compressed field', & - & 'which does not have the right size.', & - & 'We will try to fix that.') - ENDIF - IF (k_typ == k_i) THEN - i_cmpval = i_val(it) - ELSE IF (k_typ == k_r) THEN - r_cmpval = r_val(it) - ENDIF - ENDIF - ENDIF - ELSE - found(it) = .FALSE. - def_beha = .FALSE. - compressed = .FALSE. - ENDIF - ENDDO -!- - IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN -!--- -!-- If this is a compressed field then we will uncompress it - IF (compressed) THEN - DO it=1,nb_to_ret - IF (.NOT.found(it)) THEN - IF (k_typ == k_i) THEN - i_val(it) = i_cmpval - ELSE IF (k_typ == k_r) THEN - ENDIF - found(it) = .TRUE. - ENDIF - ENDDO - ENDIF - ENDIF -!- -! Now we set the status for what we found - IF (def_beha) THEN - status = 2 - WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target) - ELSE - status_cnt = 0 - DO it=1,nb_to_ret - IF (.NOT.found(it)) THEN - status_cnt = status_cnt+1 - IF (status_cnt <= max_msgs) THEN - WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', & - & ADVANCE='NO') TRIM(target) - IF (nb_to_ret > 1) THEN - WRITE (UNIT=*,FMT='("__")',ADVANCE='NO') - WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it - ENDIF - SELECT CASE (k_typ) - CASE(k_i) - WRITE (UNIT=*,FMT=*) "=",i_val(it) - CASE(k_r) - WRITE (UNIT=*,FMT=*) "=",r_val(it) - CASE(k_c) - WRITE (UNIT=*,FMT=*) "=",c_val(it) - CASE(k_l) - WRITE (UNIT=*,FMT=*) "=",l_val(it) - END SELECT - ELSE IF (status_cnt == max_msgs+1) THEN - WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)') - ENDIF - ENDIF - ENDDO -!--- - IF (status_cnt == 0) THEN - status = 1 - ELSE IF (status_cnt == nb_to_ret) THEN - status = 2 - ELSE - status = 3 - ENDIF - ENDIF -! Deallocate the memory - DEALLOCATE(found) -!--------------------- -END SUBROUTINE get_fil -!=== -SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val) -!--------------------------------------------------------------------- -!- Read the required variable in the database -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: pos,size_of_in - CHARACTER(LEN=*) :: target - INTEGER,DIMENSION(:),OPTIONAL :: i_val - REAL,DIMENSION(:),OPTIONAL :: r_val - LOGICAL,DIMENSION(:),OPTIONAL :: l_val - CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val -!- - INTEGER :: k_typ,k_beg,k_end - CHARACTER(LEN=9) :: c_vtyp -!--------------------------------------------------------------------- -!- -! Get the type of the argument - CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) - IF ( (k_typ /= k_i).AND.(k_typ /= k_r) & - & .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN - CALL ipslerr (3,'get_rdb', & - & 'Internal error','Unknown type of data',' ') - ENDIF -!- - IF (key_tab(pos)%keytype /= k_typ) THEN - CALL ipslerr (3,'get_rdb', & - & 'Wrong data type for keyword '//TRIM(target), & - & '(NOT '//TRIM(c_vtyp)//')',' ') - ENDIF -!- - IF (key_tab(pos)%keycompress > 0) THEN - IF ( (key_tab(pos)%keycompress /= size_of_in) & - & .OR.(key_tab(pos)%keymemlen /= 1) ) THEN - CALL ipslerr (3,'get_rdb', & - & 'Wrong compression length','for keyword '//TRIM(target),' ') - ELSE - SELECT CASE (k_typ) - CASE(k_i) - i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart) - CASE(k_r) - r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart) - END SELECT - ENDIF - ELSE - IF (key_tab(pos)%keymemlen /= size_of_in) THEN - CALL ipslerr (3,'get_rdb', & - & 'Wrong array length','for keyword '//TRIM(target),' ') - ELSE - k_beg = key_tab(pos)%keymemstart - k_end = k_beg+key_tab(pos)%keymemlen-1 - SELECT CASE (k_typ) - CASE(k_i) - i_val(1:size_of_in) = i_mem(k_beg:k_end) - CASE(k_r) - r_val(1:size_of_in) = r_mem(k_beg:k_end) - CASE(k_c) - c_val(1:size_of_in) = c_mem(k_beg:k_end) - CASE(k_l) - l_val(1:size_of_in) = l_mem(k_beg:k_end) - END SELECT - ENDIF - ENDIF -!--------------------- -END SUBROUTINE get_rdb -!=== -SUBROUTINE get_wdb & - & (target,status,fileorig,size_of_in, & - & i_val,r_val,c_val,l_val) -!--------------------------------------------------------------------- -!- Write data into the data base -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: target - INTEGER :: status,fileorig,size_of_in - INTEGER,DIMENSION(:),OPTIONAL :: i_val - REAL,DIMENSION(:),OPTIONAL :: r_val - LOGICAL,DIMENSION(:),OPTIONAL :: l_val - CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val -!- - INTEGER :: k_typ - CHARACTER(LEN=9) :: c_vtyp - INTEGER :: k_mempos,k_memsize,k_beg,k_end - LOGICAL :: l_cmp -!--------------------------------------------------------------------- -!- -! Get the type of the argument - CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) - IF ( (k_typ /= k_i).AND.(k_typ /= k_r) & - & .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN - CALL ipslerr (3,'get_wdb', & - & 'Internal error','Unknown type of data',' ') - ENDIF -!- -! First check if we have sufficiant space for the new key - IF (nb_keys+1 > keymemsize) THEN - CALL getin_allockeys () - ENDIF -!- - SELECT CASE (k_typ) - CASE(k_i) - k_mempos = i_mempos; k_memsize = i_memsize; - l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) & - & .AND.(size_of_in > compress_lim) - CASE(k_r) - k_mempos = r_mempos; k_memsize = r_memsize; - l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) & - & .AND.(size_of_in > compress_lim) - CASE(k_c) - k_mempos = c_mempos; k_memsize = c_memsize; - l_cmp = .FALSE. - CASE(k_l) - k_mempos = l_mempos; k_memsize = l_memsize; - l_cmp = .FALSE. - END SELECT -!- -! Fill out the items of the data base - nb_keys = nb_keys+1 - key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n)) - key_tab(nb_keys)%keystatus = status - key_tab(nb_keys)%keytype = k_typ - key_tab(nb_keys)%keyfromfile = fileorig - key_tab(nb_keys)%keymemstart = k_mempos+1 - IF (l_cmp) THEN - key_tab(nb_keys)%keycompress = size_of_in - key_tab(nb_keys)%keymemlen = 1 - ELSE - key_tab(nb_keys)%keycompress = -1 - key_tab(nb_keys)%keymemlen = size_of_in - ENDIF -!- -! Before writing the actual size lets see if we have the space - IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen & - & > k_memsize) THEN - CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen) - ENDIF -!- - k_beg = key_tab(nb_keys)%keymemstart - k_end = k_beg+key_tab(nb_keys)%keymemlen-1 - SELECT CASE (k_typ) - CASE(k_i) - i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen) - i_mempos = k_end - CASE(k_r) - r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen) - r_mempos = k_end - CASE(k_c) - c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen) - c_mempos = k_end - CASE(k_l) - l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen) - l_mempos = k_end - END SELECT -!--------------------- -END SUBROUTINE get_wdb -!- -!=== -!- -SUBROUTINE getin_read -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER,SAVE :: allread=0 - INTEGER,SAVE :: current -!--------------------------------------------------------------------- - IF (allread == 0) THEN -!-- Allocate a first set of memory. - CALL getin_alloctxt () - CALL getin_allockeys () - CALL getin_allocmem (k_i,0) - CALL getin_allocmem (k_r,0) - CALL getin_allocmem (k_c,0) - CALL getin_allocmem (k_l,0) -!-- Start with reading the files - nbfiles = 1 - filelist(1) = 'run.def' - current = 1 -!-- - DO WHILE (current <= nbfiles) - CALL getin_readdef (current) - current = current+1 - ENDDO - allread = 1 - CALL getin_checkcohe () - ENDIF -!------------------------ -END SUBROUTINE getin_read -!- -!=== -!- - SUBROUTINE getin_readdef(current) -!--------------------------------------------------------------------- -!- This subroutine will read the files and only keep the -!- the relevant information. The information is kept as it -!- found in the file. The data will be analysed later. -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: current -!- - CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str - CHARACTER(LEN=n_d_fmt) :: cnt - CHARACTER(LEN=10) :: c_fmt - INTEGER :: nb_lastkey -!- - INTEGER :: eof,ptn,len_str,i,it,iund,io_err - LOGICAL :: check = .FALSE. -!--------------------------------------------------------------------- - eof = 0 - ptn = 1 - nb_lastkey = 0 -!- - IF (check) THEN - WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current)) - ENDIF -!- - OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err) - IF (io_err /= 0) THEN - CALL ipslerr (2,'getin_readdef', & - & 'Could not open file '//TRIM(filelist(current)),' ',' ') - RETURN - ENDIF -!- - DO WHILE (eof /= 1) -!--- - CALL getin_skipafew (22,READ_str,eof,nb_lastkey) - len_str = LEN_TRIM(READ_str) - ptn = INDEX(READ_str,'=') -!--- - IF (ptn > 0) THEN -!---- Get the target - key_str = TRIM(ADJUSTL(READ_str(1:ptn-1))) -!---- Make sure that a vector keyword has the right length - iund = INDEX(key_str,'__') - IF (iund > 0) THEN - WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') & - & LEN_TRIM(key_str)-iund-1 - READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), & - & FMT=c_fmt,IOSTAT=io_err) it - IF ( (io_err == 0).AND.(it > 0) ) THEN - WRITE(UNIT=cnt,FMT=c_i_fmt) it - key_str = key_str(1:iund+1)//cnt - ELSE - CALL ipslerr (3,'getin_readdef', & - & 'A very strange key has just been found :', & - & TRIM(key_str),' ') - ENDIF - ENDIF -!---- Prepare the content - NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str))) - CALL nocomma (NEW_str) - CALL cmpblank (NEW_str) - NEW_str = TRIM(ADJUSTL(NEW_str)) - IF (check) THEN - WRITE(*,*) & - & '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str) - ENDIF -!---- Decypher the content of NEW_str -!- -!---- This has to be a new key word, thus : - nb_lastkey = 0 -!---- - CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey) -!---- - ELSE IF (len_str > 0) THEN -!---- Prepare the key if we have an old one to which -!---- we will add the line just read - IF (nb_lastkey > 0) THEN - iund = INDEX(last_key,'__') - IF (iund > 0) THEN -!-------- We only continue a keyword, thus it is easy - key_str = last_key(1:iund-1) - ELSE - IF (nb_lastkey /= 1) THEN - CALL ipslerr (3,'getin_readdef', & - & 'We can not have a scalar keyword', & - & 'and a vector content',' ') - ENDIF -!-------- The last keyword needs to be transformed into a vector. - WRITE(UNIT=cnt,FMT=c_i_fmt) 1 - targetlist(nb_lines) = & - & last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt - key_str = last_key(1:LEN_TRIM(last_key)) - ENDIF - ENDIF -!---- Prepare the content - NEW_str = TRIM(ADJUSTL(READ_str(1:len_str))) - CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey) - ELSE -!---- If we have an empty line then the keyword finishes - nb_lastkey = 0 - IF (check) THEN - WRITE(*,*) 'getin_readdef : Have found an emtpy line ' - ENDIF - ENDIF - ENDDO -!- - CLOSE(UNIT=22) -!- - IF (check) THEN - OPEN (UNIT=22,file='run.def.test') - DO i=1,nb_lines - WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i) - ENDDO - CLOSE(UNIT=22) - ENDIF -!--------------------------- -END SUBROUTINE getin_readdef -!- -!=== -!- -SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey) -!--------------------------------------------------------------------- -!- This subroutine is going to decypher the line. -!- It essentialy checks how many items are included and -!- it they can be attached to a key. -!--------------------------------------------------------------------- - IMPLICIT NONE -!- -! ARGUMENTS -!- - INTEGER :: current,nb_lastkey - CHARACTER(LEN=*) :: key_str,NEW_str,last_key -!- -! LOCAL -!- - INTEGER :: len_str,blk,nbve,starpos - CHARACTER(LEN=100) :: tmp_str,new_key,mult - CHARACTER(LEN=n_d_fmt) :: cnt - CHARACTER(LEN=10) :: c_fmt -!--------------------------------------------------------------------- - len_str = LEN_TRIM(NEW_str) - blk = INDEX(NEW_str(1:len_str),' ') - tmp_str = NEW_str(1:len_str) -!- -! If the key is a new file then we take it up. Else -! we save the line and go on. -!- - IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN - DO WHILE (blk > 0) - IF (nbfiles+1 > max_files) THEN - CALL ipslerr (3,'getin_decrypt', & - & 'Too many files to include',' ',' ') - ENDIF -!----- - nbfiles = nbfiles+1 - filelist(nbfiles) = tmp_str(1:blk) -!----- - tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str)))) - blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ') - ENDDO -!--- - IF (nbfiles+1 > max_files) THEN - CALL ipslerr (3,'getin_decrypt', & - & 'Too many files to include',' ',' ') - ENDIF -!--- - nbfiles = nbfiles+1 - filelist(nbfiles) = TRIM(ADJUSTL(tmp_str)) -!--- - last_key = 'INCLUDEDEF' - nb_lastkey = 1 - ELSE -!- -!-- We are working on a new line of input -!- - IF (nb_lines+1 > i_txtsize) THEN - CALL getin_alloctxt () - ENDIF - nb_lines = nb_lines+1 -!- -!-- First we solve the issue of conpressed information. Once -!-- this is done all line can be handled in the same way. -!- - starpos = INDEX(NEW_str(1:len_str),'*') - IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') & - & .AND.(tmp_str(1:1) /= "'") ) THEN -!----- - IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN - CALL ipslerr (3,'getin_decrypt', & - & 'We can not have a compressed field of values', & - & 'in a vector notation (TARGET__n).', & - & 'The key at fault : '//TRIM(key_str)) - ENDIF -!- -!---- Read the multiplied -!- - mult = TRIM(ADJUSTL(NEW_str(1:starpos-1))) -!---- Construct the new string and its parameters - NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str))) - len_str = LEN_TRIM(NEW_str) - blk = INDEX(NEW_str(1:len_str),' ') - IF (blk > 1) THEN - CALL ipslerr (2,'getin_decrypt', & - & 'This is a strange behavior','you could report',' ') - ENDIF - WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult) - READ(UNIT=mult,FMT=c_fmt) compline(nb_lines) -!--- - ELSE - compline(nb_lines) = -1 - ENDIF -!- -!-- If there is no space wthin the line then the target is a scalar -!-- or the element of a properly written vector. -!-- (ie of the type TARGET__00001) -!- - IF ( (blk <= 1) & - & .OR.(tmp_str(1:1) == '"') & - & .OR.(tmp_str(1:1) == "'") ) THEN -!- - IF (nb_lastkey == 0) THEN -!------ Save info of current keyword as a scalar -!------ if it is not a continuation - targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n)) - last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n)) - nb_lastkey = 1 - ELSE -!------ We are continuing a vector so the keyword needs -!------ to get the underscores - WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1 - targetlist(nb_lines) = & - & key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt - last_key = & - & key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt - nb_lastkey = nb_lastkey+1 - ENDIF -!----- - fichier(nb_lines) = NEW_str(1:len_str) - fromfile(nb_lines) = current - ELSE -!- -!---- If there are blanks whithin the line then we are dealing -!---- with a vector and we need to split it in many entries -!---- with the TARGET__n notation. -!---- -!---- Test if the targer is not already a vector target ! -!- - IF (INDEX(TRIM(key_str),'__') > 0) THEN - CALL ipslerr (3,'getin_decrypt', & - & 'We have found a mixed vector notation (TARGET__n).', & - & 'The key at fault : '//TRIM(key_str),' ') - ENDIF -!- - nbve = nb_lastkey - nbve = nbve+1 - WRITE(UNIT=cnt,FMT=c_i_fmt) nbve -!- - DO WHILE (blk > 0) -!- -!------ Save the content of target__nbve -!- - fichier(nb_lines) = tmp_str(1:blk) - new_key = & - & key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt - targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n)) - fromfile(nb_lines) = current -!- - tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str)))) - blk = INDEX(TRIM(tmp_str),' ') -!- - IF (nb_lines+1 > i_txtsize) THEN - CALL getin_alloctxt () - ENDIF - nb_lines = nb_lines+1 - nbve = nbve+1 - WRITE(UNIT=cnt,FMT=c_i_fmt) nbve -!- - ENDDO -!- -!---- Save the content of the last target -!- - fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str)) - new_key = & - & key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt - targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n)) - fromfile(nb_lines) = current -!- - last_key = & - & key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt - nb_lastkey = nbve -!- - ENDIF -!- - ENDIF -!--------------------------- -END SUBROUTINE getin_decrypt -!- -!=== -!- -SUBROUTINE getin_checkcohe () -!--------------------------------------------------------------------- -!- This subroutine checks for redundancies. -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: line,n_k,k -!--------------------------------------------------------------------- - DO line=1,nb_lines-1 -!- - n_k = 0 - DO k=line+1,nb_lines - IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN - n_k = k - EXIT - ENDIF - ENDDO -!--- -!-- IF we have found it we have a problem to solve. -!--- - IF (n_k > 0) THEN - WRITE(*,*) 'COUNT : ',n_k - WRITE(*,*) & - & 'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line)) - WRITE(*,*) & - & 'getin_checkcohe : The following values were encoutered :' - WRITE(*,*) & - & ' ',TRIM(targetlist(line)),' == ',fichier(line) - WRITE(*,*) & - & ' ',TRIM(targetlist(k)),' == ',fichier(k) - WRITE(*,*) & - & 'getin_checkcohe : We will keep only the last value' - targetlist(line) = ' ' - ENDIF - ENDDO -!----------------------------- -END SUBROUTINE getin_checkcohe -!- -!=== -!- -SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: unit,eof,nb_lastkey - CHARACTER(LEN=100) :: dummy - CHARACTER(LEN=100) :: out_string - CHARACTER(LEN=1) :: first -!--------------------------------------------------------------------- - first="#" - eof = 0 - out_string = " " -!- - DO WHILE (first == "#") - READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy - dummy = TRIM(ADJUSTL(dummy)) - first=dummy(1:1) - IF (first == "#") THEN - nb_lastkey = 0 - ENDIF - ENDDO - out_string=dummy -!- - RETURN -!- -9998 CONTINUE - CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ') -!- -7778 CONTINUE - eof = 1 -!---------------------------- -END SUBROUTINE getin_skipafew -!- -!=== -!- -SUBROUTINE getin_allockeys () -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab - CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:) -!- - INTEGER :: ier - CHARACTER(LEN=20) :: c_tmp -!--------------------------------------------------------------------- - IF (keymemsize == 0) THEN -!--- -!-- Nothing exists in memory arrays and it is easy to do. -!--- - WRITE (UNIT=c_tmp,FMT=*) memslabs - ALLOCATE(key_tab(memslabs),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_allockeys', & - & 'Can not allocate key_tab', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - nb_keys = 0 - keymemsize = memslabs - key_tab(:)%keycompress = -1 -!--- - ELSE -!--- -!-- There is something already in the memory, -!-- we need to transfer and reallocate. -!--- - WRITE (UNIT=c_tmp,FMT=*) keymemsize - ALLOCATE(tmp_key_tab(keymemsize),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_allockeys', & - & 'Can not allocate tmp_key_tab', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs - tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize) - DEALLOCATE(key_tab) - ALLOCATE(key_tab(keymemsize+memslabs),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_allockeys', & - & 'Can not allocate key_tab', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - key_tab(:)%keycompress = -1 - key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize) - DEALLOCATE(tmp_key_tab) - keymemsize = keymemsize+memslabs - ENDIF -!----------------------------- -END SUBROUTINE getin_allockeys -!- -!=== -!- -SUBROUTINE getin_allocmem (type,len_wanted) -!--------------------------------------------------------------------- -!- Allocate the memory of the data base for all 4 types of memory -!- INTEGER / REAL / CHARACTER / LOGICAL -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: type,len_wanted -!- - INTEGER,ALLOCATABLE :: tmp_int(:) - REAL,ALLOCATABLE :: tmp_real(:) - CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:) - LOGICAL,ALLOCATABLE :: tmp_logic(:) - INTEGER :: ier - CHARACTER(LEN=20) :: c_tmp -!--------------------------------------------------------------------- - SELECT CASE (type) - CASE(k_i) - IF (i_memsize == 0) THEN - ALLOCATE(i_mem(memslabs),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) memslabs - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate db-memory', & - & 'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - i_memsize=memslabs - ELSE - ALLOCATE(tmp_int(i_memsize),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) i_memsize - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate tmp_int', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - tmp_int(1:i_memsize) = i_mem(1:i_memsize) - DEALLOCATE(i_mem) - ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted) - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to re-allocate db-memory', & - & 'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - i_mem(1:i_memsize) = tmp_int(1:i_memsize) - i_memsize = i_memsize+MAX(memslabs,len_wanted) - DEALLOCATE(tmp_int) - ENDIF - CASE(k_r) - IF (r_memsize == 0) THEN - ALLOCATE(r_mem(memslabs),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) memslabs - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate db-memory', & - & 'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - r_memsize = memslabs - ELSE - ALLOCATE(tmp_real(r_memsize),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) r_memsize - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate tmp_real', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - tmp_real(1:r_memsize) = r_mem(1:r_memsize) - DEALLOCATE(r_mem) - ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted) - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to re-allocate db-memory', & - & 'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - r_mem(1:r_memsize) = tmp_real(1:r_memsize) - r_memsize = r_memsize+MAX(memslabs,len_wanted) - DEALLOCATE(tmp_real) - ENDIF - CASE(k_c) - IF (c_memsize == 0) THEN - ALLOCATE(c_mem(memslabs),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) memslabs - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate db-memory', & - & 'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - c_memsize = memslabs - ELSE - ALLOCATE(tmp_char(c_memsize),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) c_memsize - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate tmp_char', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - tmp_char(1:c_memsize) = c_mem(1:c_memsize) - DEALLOCATE(c_mem) - ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted) - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to re-allocate db-memory', & - & 'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - c_mem(1:c_memsize) = tmp_char(1:c_memsize) - c_memsize = c_memsize+MAX(memslabs,len_wanted) - DEALLOCATE(tmp_char) - ENDIF - CASE(k_l) - IF (l_memsize == 0) THEN - ALLOCATE(l_mem(memslabs),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) memslabs - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate db-memory', & - & 'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - l_memsize = memslabs - ELSE - ALLOCATE(tmp_logic(l_memsize),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) l_memsize - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to allocate tmp_logic', & - & 'to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - tmp_logic(1:l_memsize) = l_mem(1:l_memsize) - DEALLOCATE(l_mem) - ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier) - IF (ier /= 0) THEN - WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted) - CALL ipslerr (3,'getin_allocmem', & - & 'Unable to re-allocate db-memory', & - & 'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') - ENDIF - l_mem(1:l_memsize) = tmp_logic(1:l_memsize) - l_memsize = l_memsize+MAX(memslabs,len_wanted) - DEALLOCATE(tmp_logic) - ENDIF - CASE DEFAULT - CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ') - END SELECT -!---------------------------- -END SUBROUTINE getin_allocmem -!- -!=== -!- -SUBROUTINE getin_alloctxt () -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:) - CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:) - INTEGER,ALLOCATABLE :: tmp_int(:) -!- - INTEGER :: ier - CHARACTER(LEN=20) :: c_tmp1,c_tmp2 -!--------------------------------------------------------------------- - IF (i_txtsize == 0) THEN -!--- -!-- Nothing exists in memory arrays and it is easy to do. -!--- - WRITE (UNIT=c_tmp1,FMT=*) i_txtslab - ALLOCATE(fichier(i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate fichier', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF -!--- - ALLOCATE(targetlist(i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate targetlist', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF -!--- - ALLOCATE(fromfile(i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate fromfile', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF -!--- - ALLOCATE(compline(i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate compline', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF -!--- - nb_lines = 0 - i_txtsize = i_txtslab - ELSE -!--- -!-- There is something already in the memory, -!-- we need to transfer and reallocate. -!--- - WRITE (UNIT=c_tmp1,FMT=*) i_txtsize - WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab - ALLOCATE(tmp_fic(i_txtsize),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate tmp_fic', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF - tmp_fic(1:i_txtsize) = fichier(1:i_txtsize) - DEALLOCATE(fichier) - ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate fichier', & - & 'to size '//TRIM(ADJUSTL(c_tmp2)),' ') - ENDIF - fichier(1:i_txtsize) = tmp_fic(1:i_txtsize) - DEALLOCATE(tmp_fic) -!--- - ALLOCATE(tmp_tgl(i_txtsize),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate tmp_tgl', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF - tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize) - DEALLOCATE(targetlist) - ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate targetlist', & - & 'to size '//TRIM(ADJUSTL(c_tmp2)),' ') - ENDIF - targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize) - DEALLOCATE(tmp_tgl) -!--- - ALLOCATE(tmp_int(i_txtsize),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate tmp_int', & - & 'to size '//TRIM(ADJUSTL(c_tmp1)),' ') - ENDIF - tmp_int(1:i_txtsize) = fromfile(1:i_txtsize) - DEALLOCATE(fromfile) - ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate fromfile', & - & 'to size '//TRIM(ADJUSTL(c_tmp2)),' ') - ENDIF - fromfile(1:i_txtsize) = tmp_int(1:i_txtsize) -!--- - tmp_int(1:i_txtsize) = compline(1:i_txtsize) - DEALLOCATE(compline) - ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier) - IF (ier /= 0) THEN - CALL ipslerr (3,'getin_alloctxt', & - & 'Can not allocate compline', & - & 'to size '//TRIM(ADJUSTL(c_tmp2)),' ') - ENDIF - compline(1:i_txtsize) = tmp_int(1:i_txtsize) - DEALLOCATE(tmp_int) -!--- - i_txtsize = i_txtsize+i_txtslab - ENDIF -!---------------------------- -END SUBROUTINE getin_alloctxt -!- -!=== -!- -SUBROUTINE getin_dump (fileprefix) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(*),OPTIONAL :: fileprefix -!- - CHARACTER(LEN=80) :: usedfileprefix - INTEGER :: ikey,if,iff,iv - CHARACTER(LEN=20) :: c_tmp - CHARACTER(LEN=100) :: tmp_str,used_filename - LOGICAL :: check = .FALSE. -!--------------------------------------------------------------------- - IF (PRESENT(fileprefix)) THEN - usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80)) - ELSE - usedfileprefix = "used" - ENDIF -!- - DO if=1,nbfiles -!--- - used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if)) - IF (check) THEN - WRITE(*,*) & - & 'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if - WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys - ENDIF - OPEN (UNIT=22,FILE=used_filename) -!--- -!-- If this is the first file we need to add the list -!-- of file which belong to it - IF ( (if == 1).AND.(nbfiles > 1) ) THEN - WRITE(22,*) '# ' - WRITE(22,*) '# This file is linked to the following files :' - WRITE(22,*) '# ' - DO iff=2,nbfiles - WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff)) - ENDDO - WRITE(22,*) '# ' - ENDIF -!--- - DO ikey=1,nb_keys -!----- -!---- Is this key from this file ? - IF (key_tab(ikey)%keyfromfile == if) THEN -!------- -!------ Write some comments - WRITE(22,*) '#' - SELECT CASE (key_tab(ikey)%keystatus) - CASE(1) - WRITE(22,*) '# Values of ', & - & TRIM(key_tab(ikey)%keystr),' comes from the run.def.' - CASE(2) - WRITE(22,*) '# Values of ', & - & TRIM(key_tab(ikey)%keystr),' are all defaults.' - CASE(3) - WRITE(22,*) '# Values of ', & - & TRIM(key_tab(ikey)%keystr), & - & ' are a mix of run.def and defaults.' - CASE DEFAULT - WRITE(22,*) '# Dont know from where the value of ', & - & TRIM(key_tab(ikey)%keystr),' comes.' - END SELECT - WRITE(22,*) '#' -!------- -!------ Write the values - SELECT CASE (key_tab(ikey)%keytype) - CASE(k_i) - IF (key_tab(ikey)%keymemlen == 1) THEN - IF (key_tab(ikey)%keycompress < 0) THEN - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & ' = ',i_mem(key_tab(ikey)%keymemstart) - ELSE - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & ' = ',key_tab(ikey)%keycompress, & - & ' * ',i_mem(key_tab(ikey)%keymemstart) - ENDIF - ELSE - DO iv=0,key_tab(ikey)%keymemlen-1 - WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & '__',TRIM(ADJUSTL(c_tmp)), & - & ' = ',i_mem(key_tab(ikey)%keymemstart+iv) - ENDDO - ENDIF - CASE(k_r) - IF (key_tab(ikey)%keymemlen == 1) THEN - IF (key_tab(ikey)%keycompress < 0) THEN - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & ' = ',r_mem(key_tab(ikey)%keymemstart) - ELSE - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & ' = ',key_tab(ikey)%keycompress, & - & ' * ',r_mem(key_tab(ikey)%keymemstart) - ENDIF - ELSE - DO iv=0,key_tab(ikey)%keymemlen-1 - WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), & - & ' = ',r_mem(key_tab(ikey)%keymemstart+iv) - ENDDO - ENDIF - CASE(k_c) - IF (key_tab(ikey)%keymemlen == 1) THEN - tmp_str = c_mem(key_tab(ikey)%keymemstart) - WRITE(22,*) TRIM(key_tab(ikey)%keystr), & - & ' = ',TRIM(tmp_str) - ELSE - DO iv=0,key_tab(ikey)%keymemlen-1 - WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 - tmp_str = c_mem(key_tab(ikey)%keymemstart+iv) - WRITE(22,*) & - & TRIM(key_tab(ikey)%keystr), & - & '__',TRIM(ADJUSTL(c_tmp)), & - & ' = ',TRIM(tmp_str) - ENDDO - ENDIF - CASE(k_l) - IF (key_tab(ikey)%keymemlen == 1) THEN - IF (l_mem(key_tab(ikey)%keymemstart)) THEN - WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE ' - ELSE - WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE ' - ENDIF - ELSE - DO iv=0,key_tab(ikey)%keymemlen-1 - WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 - IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN - WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', & - & TRIM(ADJUSTL(c_tmp)),' = TRUE ' - ELSE - WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', & - & TRIM(ADJUSTL(c_tmp)),' = FALSE ' - ENDIF - ENDDO - ENDIF - CASE DEFAULT - CALL ipslerr (3,'getin_dump', & - & 'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), & - & ' ',' ') - END SELECT - ENDIF - ENDDO -!- - CLOSE(UNIT=22) -!- - ENDDO -!------------------------ -END SUBROUTINE getin_dump -!=== -SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v) -!--------------------------------------------------------------------- -!- Returns the type of the argument (mutually exclusive) -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER,INTENT(OUT) :: k_typ - CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp - INTEGER,DIMENSION(:),OPTIONAL :: i_v - REAL,DIMENSION(:),OPTIONAL :: r_v - LOGICAL,DIMENSION(:),OPTIONAL :: l_v - CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v -!--------------------------------------------------------------------- - k_typ = 0 - IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) & - & /= 1) THEN - CALL ipslerr (3,'get_qtyp', & - & 'Invalid number of optional arguments','(/= 1)',' ') - ENDIF -!- - IF (PRESENT(i_v)) THEN - k_typ = k_i - c_vtyp = 'INTEGER' - ELSEIF (PRESENT(r_v)) THEN - k_typ = k_r - c_vtyp = 'REAL' - ELSEIF (PRESENT(c_v)) THEN - k_typ = k_c - c_vtyp = 'CHARACTER' - ELSEIF (PRESENT(l_v)) THEN - k_typ = k_l - c_vtyp = 'LOGICAL' - ENDIF -!---------------------- -END SUBROUTINE get_qtyp -!=== -SUBROUTINE get_findkey (i_tab,c_key,pos) -!--------------------------------------------------------------------- -!- This subroutine looks for a key in a table -!--------------------------------------------------------------------- -!- INPUT -!- i_tab : 1 -> search in key_tab(1:nb_keys)%keystr -!- 2 -> search in targetlist(1:nb_lines) -!- c_key : Name of the key we are looking for -!- OUTPUT -!- pos : -1 if key not found, else value in the table -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER,INTENT(in) :: i_tab - CHARACTER(LEN=*),INTENT(in) :: c_key - INTEGER,INTENT(out) :: pos -!- - INTEGER :: ikey_max,ikey - CHARACTER(LEN=l_n) :: c_q_key -!--------------------------------------------------------------------- - pos = -1 - IF (i_tab == 1) THEN - ikey_max = nb_keys - ELSEIF (i_tab == 2) THEN - ikey_max = nb_lines - ELSE - ikey_max = 0 - ENDIF - IF ( ikey_max > 0 ) THEN - DO ikey=1,ikey_max - IF (i_tab == 1) THEN - c_q_key = key_tab(ikey)%keystr - ELSE - c_q_key = targetlist(ikey) - ENDIF - IF (TRIM(c_q_key) == TRIM(c_key)) THEN - pos = ikey - EXIT - ENDIF - ENDDO - ENDIF -!------------------------- -END SUBROUTINE get_findkey -!=== -!------------------ -END MODULE ioipsl_getincom Index: LMDZ6/trunk/libf/misc/ioipsl_stringop.F90 =================================================================== --- LMDZ6/trunk/libf/misc/ioipsl_stringop.F90 (revision 5266) +++ (revision ) @@ -1,243 +1,0 @@ -! -! $Id$ -! -! Module/Routines extracted from IOIPSL v2_1_8 -! -MODULE ioipsl_stringop -!- -!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $ -!- -! This software is governed by the CeCILL license -! See IOIPSL/IOIPSL_License_CeCILL.txt -!--------------------------------------------------------------------- -!- - INTEGER,DIMENSION(30) :: & - & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, & - & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/) -!- -!--------------------------------------------------------------------- -CONTAINS -!= -SUBROUTINE cmpblank (str) -!--------------------------------------------------------------------- -!- Compact blanks -!--------------------------------------------------------------------- - CHARACTER(LEN=*),INTENT(inout) :: str -!- - INTEGER :: lcc,ipb -!--------------------------------------------------------------------- - lcc = LEN_TRIM(str) - ipb = 1 - DO - IF (ipb >= lcc) EXIT - IF (str(ipb:ipb+1) == ' ') THEN - str(ipb+1:) = str(ipb+2:lcc) - lcc = lcc-1 - ELSE - ipb = ipb+1 - ENDIF - ENDDO -!---------------------- -END SUBROUTINE cmpblank -!=== -INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r) -!--------------------------------------------------------------------- -!- Finds number of occurences of c_r in c_c -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*),INTENT(in) :: c_c - INTEGER,INTENT(IN) :: l_c - CHARACTER(LEN=*),INTENT(in) :: c_r - INTEGER,INTENT(IN) :: l_r -!- - INTEGER :: ipos,indx -!--------------------------------------------------------------------- - cntpos = 0 - ipos = 1 - DO - indx = INDEX(c_c(ipos:l_c),c_r(1:l_r)) - IF (indx > 0) THEN - cntpos = cntpos+1 - ipos = ipos+indx+l_r-1 - ELSE - EXIT - ENDIF - ENDDO -!------------------ -END FUNCTION cntpos -!=== -INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r) -!--------------------------------------------------------------------- -!- Finds position of c_r in c_c -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*),INTENT(in) :: c_c - INTEGER,INTENT(IN) :: l_c - CHARACTER(LEN=*),INTENT(in) :: c_r - INTEGER,INTENT(IN) :: l_r -!--------------------------------------------------------------------- - findpos = INDEX(c_c(1:l_c),c_r(1:l_r)) - IF (findpos == 0) findpos=-1 -!------------------- -END FUNCTION findpos -!=== -SUBROUTINE find_str (str_tab,str,pos) -!--------------------------------------------------------------------- -!- This subroutine looks for a string in a table -!--------------------------------------------------------------------- -!- INPUT -!- str_tab : Table of strings -!- str : Target we are looking for -!- OUTPUT -!- pos : -1 if str not found, else value in the table -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab - CHARACTER(LEN=*),INTENT(in) :: str - INTEGER,INTENT(out) :: pos -!- - INTEGER :: nb_str,i -!--------------------------------------------------------------------- - pos = -1 - nb_str=SIZE(str_tab) - IF ( nb_str > 0 ) THEN - DO i=1,nb_str - IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN - pos = i - EXIT - ENDIF - ENDDO - ENDIF -!---------------------- -END SUBROUTINE find_str -!=== -SUBROUTINE nocomma (str) -!--------------------------------------------------------------------- -!- Replace commas with blanks -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: str -!- - INTEGER :: i -!--------------------------------------------------------------------- - DO i=1,LEN_TRIM(str) - IF (str(i:i) == ',') str(i:i) = ' ' - ENDDO -!--------------------- -END SUBROUTINE nocomma -!=== -SUBROUTINE strlowercase (str) -!--------------------------------------------------------------------- -!- Converts a string into lowercase -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: str -!- - INTEGER :: i,ic -!--------------------------------------------------------------------- - DO i=1,LEN_TRIM(str) - ic = IACHAR(str(i:i)) - IF ( (ic >= 65).AND.(ic <= 90) ) str(i:i) = ACHAR(ic+32) - ENDDO -!-------------------------- -END SUBROUTINE strlowercase -!=== -SUBROUTINE struppercase (str) -!--------------------------------------------------------------------- -!- Converts a string into uppercase -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: str -!- - INTEGER :: i,ic -!--------------------------------------------------------------------- - DO i=1,LEN_TRIM(str) - ic = IACHAR(str(i:i)) - IF ( (ic >= 97).AND.(ic <= 122) ) str(i:i) = ACHAR(ic-32) - ENDDO -!-------------------------- -END SUBROUTINE struppercase -!=== -SUBROUTINE gensig (str,sig) -!--------------------------------------------------------------------- -!- Generate a signature from the first 30 characters of the string -!- This signature is not unique and thus when one looks for the -!- one needs to also verify the string. -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - CHARACTER(LEN=*) :: str - INTEGER :: sig -!- - INTEGER :: i -!--------------------------------------------------------------------- - sig = 0 - DO i=1,MIN(LEN_TRIM(str),30) - sig = sig + prime(i)*IACHAR(str(i:i)) - ENDDO -!-------------------- -END SUBROUTINE gensig -!=== -SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos) -!--------------------------------------------------------------------- -!- Find the string signature in a list of signatures -!--------------------------------------------------------------------- -!- INPUT -!- nb_sig : length of table of signatures -!- str_tab : Table of strings -!- str : Target string we are looking for -!- sig_tab : Table of signatures -!- sig : Target signature we are looking for -!- OUTPUT -!- pos : -1 if str not found, else value in the table -!--------------------------------------------------------------------- - IMPLICIT NONE -!- - INTEGER :: nb_sig - CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab - CHARACTER(LEN=*) :: str - INTEGER,DIMENSION(nb_sig) :: sig_tab - INTEGER :: sig -!- - INTEGER :: pos - INTEGER,DIMENSION(nb_sig) :: loczeros -!- - INTEGER :: il,len - INTEGER,DIMENSION(1) :: minpos -!--------------------------------------------------------------------- - pos = -1 - il = LEN_TRIM(str) -!- - IF ( nb_sig > 0 ) THEN - loczeros = ABS(sig_tab(1:nb_sig)-sig) - IF ( COUNT(loczeros < 1) == 1 ) THEN - minpos = MINLOC(loczeros) - len = LEN_TRIM(str_tab(minpos(1))) - IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) & - .AND.(len == il) ) THEN - pos = minpos(1) - ENDIF - ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN - DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 ) - minpos = MINLOC(loczeros) - len = LEN_TRIM(str_tab(minpos(1))) - IF ( (INDEX(str_tab(minpos(1)),str(1:il)) > 0) & - .AND.(len == il) ) THEN - pos = minpos(1) - ELSE - loczeros(minpos(1)) = 99999 - ENDIF - ENDDO - ENDIF - ENDIF -!----------------------- - END SUBROUTINE find_sig -!=== -!------------------ -END MODULE ioipsl_stringop Index: LMDZ6/trunk/libf/misc/strings_mod.F90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/misc/strings_mod.F90 (revision 5267) @@ -53,5 +53,5 @@ !============================================================================================================================== SUBROUTINE getin_s(nam, val, def) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: nam @@ -63,5 +63,5 @@ !============================================================================================================================== SUBROUTINE getin_i(nam, val, def) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: nam @@ -73,5 +73,5 @@ !============================================================================================================================== SUBROUTINE getin_r(nam, val, def) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: nam @@ -83,5 +83,5 @@ !============================================================================================================================== SUBROUTINE getin_l(nam, val, def) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: nam Index: LMDZ6/trunk/libf/phy_common/abort_physic.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/abort_physic.F90 (revision 5266) +++ LMDZ6/trunk/libf/phy_common/abort_physic.F90 (revision 5267) @@ -2,10 +2,6 @@ SUBROUTINE abort_physic(modname, message, ierr) -#ifdef CPP_IOIPSL USE IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin_dump - USE ioipsl_getincom -#endif + USE mod_phys_lmdz_para USE print_control_mod, ONLY: lunout @@ -24,5 +20,4 @@ write(lunout,*) 'in abort_physic' -#ifdef CPP_IOIPSL !$OMP MASTER call histclo @@ -32,5 +27,4 @@ endif !$OMP END MASTER -#endif write(lunout,*) 'Stopping in ', modname Index: LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phy_common/ioipsl_getin_p_mod.F90 (revision 5267) @@ -5,9 +5,5 @@ ! To use getin in a parallel context !--------------------------------------------------------------------- -#ifdef CPP_IOIPSL USE ioipsl, ONLY: getin -#else -USE ioipsl_getincom, ONLY: getin -#endif USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root USE mod_phys_lmdz_omp_data, ONLY : is_omp_root Index: LMDZ6/trunk/libf/phydev/iophy.F90 =================================================================== --- LMDZ6/trunk/libf/phydev/iophy.F90 (revision 5266) +++ LMDZ6/trunk/libf/phydev/iophy.F90 (revision 5267) @@ -34,7 +34,6 @@ USE print_control_mod, ONLY: lunout, prt_level USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat -#ifdef CPP_IOIPSL USE ioipsl, only: flio_dom_set -#endif + use wxios, only: wxios_domain_param, using_xios implicit none Index: LMDZ6/trunk/libf/phylmd/Dust/phys_output_write_spl_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/Dust/phys_output_write_spl_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/Dust/phys_output_write_spl_mod.F90 (revision 5267) @@ -828,5 +828,4 @@ ! ENDIF -#ifdef CPP_IOIPSL IF (.NOT. using_xios) THEN IF (.NOT.ok_all_xml) THEN @@ -836,5 +835,5 @@ ll=0 DO k=1, nlevSTD - bb2=clevSTD(k) + bb2=clevSTD(k) IF (bb2.EQ."850".OR.bb2.EQ."700".OR. & bb2.EQ."500".OR.bb2.EQ."200".OR. & @@ -856,5 +855,5 @@ ENDIF ENDIF !.NOT.using_xios -#endif + IF (using_xios) THEN @@ -1470,8 +1469,6 @@ ENDIF !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!! -#ifdef CPP_IOIPSL - IF (.NOT. using_xios) THEN - IF (.NOT.ok_all_xml) THEN + IF (.NOT.ok_all_xml) THEN ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: ! Champs interpolles sur des niveaux de pression @@ -1541,5 +1538,5 @@ ENDIF ENDIF -#endif + IF (using_xios) THEN Index: LMDZ6/trunk/libf/phylmd/dyn1d/1DUTILS.h =================================================================== --- LMDZ6/trunk/libf/phylmd/dyn1d/1DUTILS.h (revision 5266) +++ LMDZ6/trunk/libf/phylmd/dyn1d/1DUTILS.h (revision 5267) @@ -8,10 +8,6 @@ SUBROUTINE conf_unicol ! -#ifdef CPP_IOIPSL use IOIPSL -#else -! if not using IOIPSL, we still need to use (a local version of) getin - use ioipsl_getincom -#endif + USE print_control_mod, ONLY: lunout IMPLICIT NONE Index: LMDZ6/trunk/libf/phylmd/iophy.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/iophy.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/iophy.F90 (revision 5267) @@ -43,7 +43,6 @@ USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured USE print_control_mod, ONLY: prt_level,lunout -#ifdef CPP_IOIPSL USE ioipsl, ONLY: flio_dom_set -#endif + use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init, using_xios IMPLICIT NONE Index: LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90 (revision 5267) @@ -5,7 +5,5 @@ USE netcdf USE dimphy -#ifdef CPP_IOIPSL USE phys_state_var_mod -#endif USE wxios, ONLY: missing_val_xios => missing_val, using_xios Index: LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 5267) @@ -1493,5 +1493,4 @@ ! ENDIF -#ifdef CPP_IOIPSL IF (.NOT. using_xios) THEN IF (.NOT.ok_all_xml) THEN @@ -1501,5 +1500,5 @@ ll=0 DO k=1, nlevSTD - bb2=clevSTD(k) + bb2=clevSTD(k) IF (bb2.EQ."850".OR.bb2.EQ."700".OR. & bb2.EQ."500".OR.bb2.EQ."200".OR. & @@ -1521,5 +1520,5 @@ ENDIF ENDIF -#endif + IF (using_xios) THEN @@ -2620,7 +2619,6 @@ ENDIF !ok_4xCO2atm !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!! -#ifdef CPP_IOIPSL IF (.NOT. using_xios) THEN - IF (.NOT.ok_all_xml) THEN + IF (.NOT.ok_all_xml) THEN ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: ! Champs interpolles sur des niveaux de pression @@ -2690,5 +2688,5 @@ ENDIF ENDIF !.NOT. using_xios -#endif + IF (using_xios) THEN Index: LMDZ6/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/physiq_mod.F90 (revision 5267) @@ -1730,6 +1730,4 @@ ENDIF -#ifdef CPP_IOIPSL - !$OMP MASTER ! FH : if ok_sync=.true. , the time axis is written at each time step @@ -1762,5 +1760,4 @@ #endif -#endif ecrit_reg = ecrit_reg * un_jour ecrit_tra = ecrit_tra * un_jour @@ -5682,5 +5679,4 @@ ! Ecriture des sorties !============================================================= -#ifdef CPP_IOIPSL ! Recupere des varibles calcule dans differents modules @@ -5742,5 +5738,4 @@ #endif -#endif ! Petit appelle de sorties pour accompagner le travail sur phyex if ( iflag_physiq == 1 ) then Index: LMDZ6/trunk/libf/phylmd/plevel.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/plevel.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/plevel.F90 (revision 5267) @@ -9,7 +9,5 @@ USE netcdf USE dimphy -#ifdef CPP_IOIPSL - USE phys_state_var_mod, ONLY: missing_val_nf90 -#endif + USE phys_state_var_mod, ONLY: missing_val_nf90 USE wxios, ONLY: missing_val_xios => missing_val, using_xios IMPLICIT NONE Index: LMDZ6/trunk/libf/phylmd/plevel_new.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/plevel_new.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/plevel_new.F90 (revision 5267) @@ -10,7 +10,5 @@ USE netcdf USE dimphy -#ifdef CPP_IOIPSL USE phys_state_var_mod, ONLY: missing_val_nf90 -#endif USE wxios, ONLY: missing_val_xios=>missing_val, using_xios Index: LMDZ6/trunk/libf/phylmd/undefSTD.F90 =================================================================== --- LMDZ6/trunk/libf/phylmd/undefSTD.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmd/undefSTD.F90 (revision 5267) @@ -5,7 +5,5 @@ USE netcdf USE dimphy -#ifdef CPP_IOIPSL USE phys_state_var_mod -#endif USE wxios, ONLY: missing_val_xios => missing_val, using_xios Index: LMDZ6/trunk/libf/phylmdiso/isotopes_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmdiso/isotopes_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmdiso/isotopes_mod.F90 (revision 5267) @@ -379,5 +379,5 @@ SUBROUTINE getinp_s(nam, val, def, lDisp) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root USE mod_phys_lmdz_omp_data, ONLY : is_omp_root @@ -398,5 +398,5 @@ SUBROUTINE getinp_i(nam, val, def, lDisp) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root USE mod_phys_lmdz_omp_data, ONLY : is_omp_root @@ -417,5 +417,5 @@ SUBROUTINE getinp_r(nam, val, def, lDisp) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root USE mod_phys_lmdz_omp_data, ONLY : is_omp_root @@ -436,5 +436,5 @@ SUBROUTINE getinp_l(nam, val, def, lDisp) - USE ioipsl_getincom, ONLY: getin + USE ioipsl, ONLY: getin USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root USE mod_phys_lmdz_omp_data, ONLY : is_omp_root Index: LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 =================================================================== --- LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 (revision 5266) +++ LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90 (revision 5267) @@ -1900,6 +1900,4 @@ ENDIF -#ifdef CPP_IOIPSL - !$OMP MASTER ! FH : if ok_sync=.true. , the time axis is written at each time step @@ -1932,5 +1930,4 @@ #endif -#endif ecrit_reg = ecrit_reg * un_jour ecrit_tra = ecrit_tra * un_jour @@ -7309,5 +7306,4 @@ ! Ecriture des sorties !============================================================= -#ifdef CPP_IOIPSL ! Recupere des varibles calcule dans differents modules @@ -7373,5 +7369,4 @@ #endif -#endif ! Petit appelle de sorties pour accompagner le travail sur phyex if ( iflag_physiq == 1 ) then