Index: trunk/LMDZ.COMMON/libf/misc/arth.F90 =================================================================== --- trunk/LMDZ.COMMON/libf/misc/arth.F90 (revision 1403) +++ (revision ) @@ -1,82 +1,0 @@ -MODULE arth_m - - IMPLICIT NONE - - INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8 - - INTERFACE arth - ! Returns an arithmetic progression, given a first term "first", an - ! increment and a number of terms "n". - - MODULE PROCEDURE arth_r, arth_i - ! The difference between the procedures is the type of - ! arguments "first" and "increment" and of function result. - END INTERFACE - - private arth_r, arth_i - -CONTAINS - - pure FUNCTION arth_r(first,increment,n) - - REAL, INTENT(IN) :: first,increment - INTEGER, INTENT(IN) :: n - REAL, DIMENSION(n) :: arth_r - - ! Variables local to the procedure: - - INTEGER :: k,k2 - REAL :: temp - - !--------------------------------------- - - if (n > 0) arth_r(1)=first - if (n <= NPAR_ARTH) then - do k=2,n - arth_r(k)=arth_r(k-1)+increment - end do - else - do k=2,NPAR2_ARTH - arth_r(k)=arth_r(k-1)+increment - end do - temp=increment*NPAR2_ARTH - k=NPAR2_ARTH - do - if (k >= n) exit - k2=k+k - arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k)) - temp=temp+temp - k=k2 - end do - end if - END FUNCTION arth_r - - !************************************* - - pure FUNCTION arth_i(first,increment,n) - - INTEGER, INTENT(IN) :: first,increment,n - INTEGER, DIMENSION(n) :: arth_i - INTEGER :: k,k2,temp - if (n > 0) arth_i(1)=first - if (n <= NPAR_ARTH) then - do k=2,n - arth_i(k)=arth_i(k-1)+increment - end do - else - do k=2,NPAR2_ARTH - arth_i(k)=arth_i(k-1)+increment - end do - temp=increment*NPAR2_ARTH - k=NPAR2_ARTH - do - if (k >= n) exit - k2=k+k - arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k)) - temp=temp+temp - k=k2 - end do - end if - END FUNCTION arth_i - -END MODULE arth_m Index: trunk/LMDZ.COMMON/libf/misc/arth_m.F90 =================================================================== --- trunk/LMDZ.COMMON/libf/misc/arth_m.F90 (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/arth_m.F90 (revision 1441) @@ -0,0 +1,82 @@ +MODULE arth_m + + IMPLICIT NONE + + INTEGER, PARAMETER, private:: NPAR_ARTH=16, NPAR2_ARTH=8 + + INTERFACE arth + ! Returns an arithmetic progression, given a first term "first", an + ! increment and a number of terms "n". + + MODULE PROCEDURE arth_r, arth_i + ! The difference between the procedures is the type of + ! arguments "first" and "increment" and of function result. + END INTERFACE + + private arth_r, arth_i + +CONTAINS + + pure FUNCTION arth_r(first,increment,n) + + REAL, INTENT(IN) :: first,increment + INTEGER, INTENT(IN) :: n + REAL, DIMENSION(n) :: arth_r + + ! Variables local to the procedure: + + INTEGER :: k,k2 + REAL :: temp + + !--------------------------------------- + + if (n > 0) arth_r(1)=first + if (n <= NPAR_ARTH) then + do k=2,n + arth_r(k)=arth_r(k-1)+increment + end do + else + do k=2,NPAR2_ARTH + arth_r(k)=arth_r(k-1)+increment + end do + temp=increment*NPAR2_ARTH + k=NPAR2_ARTH + do + if (k >= n) exit + k2=k+k + arth_r(k+1:min(k2,n)) = temp + arth_r(1:min(k,n-k)) + temp=temp+temp + k=k2 + end do + end if + END FUNCTION arth_r + + !************************************* + + pure FUNCTION arth_i(first,increment,n) + + INTEGER, INTENT(IN) :: first,increment,n + INTEGER, DIMENSION(n) :: arth_i + INTEGER :: k,k2,temp + if (n > 0) arth_i(1)=first + if (n <= NPAR_ARTH) then + do k=2,n + arth_i(k)=arth_i(k-1)+increment + end do + else + do k=2,NPAR2_ARTH + arth_i(k)=arth_i(k-1)+increment + end do + temp=increment*NPAR2_ARTH + k=NPAR2_ARTH + do + if (k >= n) exit + k2=k+k + arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k)) + temp=temp+temp + k=k2 + end do + end if + END FUNCTION arth_i + +END MODULE arth_m Index: trunk/LMDZ.COMMON/libf/misc/coefpoly_m.F90 =================================================================== --- trunk/LMDZ.COMMON/libf/misc/coefpoly_m.F90 (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/coefpoly_m.F90 (revision 1441) @@ -0,0 +1,52 @@ +module coefpoly_m + + IMPLICIT NONE + +contains + + SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3) + + ! From LMDZ4/libf/dyn3d/coefpoly.F, version 1.1.1.1 2004/05/19 12:53:05 + + ! Author: P. Le Van + + ! Calcul des coefficients a0, a1, a2, a3 du polynôme de degré 3 qui + ! satisfait aux 4 équations suivantes : + + ! a0 + a1 * xtild1 + a2 * xtild1**2 + a3 * xtild1**3 = Xf1 + ! a0 + a1 * xtild2 + a2 * xtild2**2 + a3 * xtild2**3 = Xf2 + ! a1 + 2. * a2 * xtild1 + 3. * a3 * xtild1**2 = Xprim1 + ! a1 + 2. * a2 * xtild2 + 3. * a3 * xtild2**2 = Xprim2 + + ! (passe par les points (Xf(it), xtild(it)) et (Xf(it + 1), + ! xtild(it + 1)) + + ! On en revient à resoudre un système de 4 équations à 4 inconnues + ! a0, a1, a2, a3. + + use nrtype, only: k8 + + REAL(K8), intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2 + REAL(K8), intent(out):: a0, a1, a2, a3 + + ! Local: + REAL(K8) xtil1car, xtil2car, derr, x1x2car + + !------------------------------------------------------------ + + xtil1car = xtild1 * xtild1 + xtil2car = xtild2 * xtild2 + + derr = 2. * (xf2-xf1)/(xtild1-xtild2) + + x1x2car = (xtild1-xtild2) * (xtild1-xtild2) + + a3 = (derr+xprim1+xprim2)/x1x2car + a2 = (xprim1-xprim2+3. * a3 * (xtil2car-xtil1car))/(2. * (xtild1-xtild2)) + + a1 = xprim1 - 3. * a3 * xtil1car - 2. * a2 * xtild1 + a0 = xf1 - a3 * xtild1 * xtil1car - a2 * xtil1car - a1 * xtild1 + + END SUBROUTINE coefpoly + +end module coefpoly_m Index: trunk/LMDZ.COMMON/libf/misc/juldate.F =================================================================== --- trunk/LMDZ.COMMON/libf/misc/juldate.F (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/juldate.F (revision 1441) @@ -0,0 +1,39 @@ +! +! $Id: juldate.F 2197 2015-02-09 07:13:05Z emillour $ +! + subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec) +c Sous-routine de changement de date: +c gregorien>>>date julienne +c En entree:an,mois,jour,heure,min.,sec. +c En sortie:tjd + IMPLICIT NONE + INTEGER,INTENT(IN) :: ian,imoi,ijou,oh,om,os + REAL,INTENT(OUT) :: tjd,tjdsec + + REAL frac,year,rmon,cf,a,b + INTEGER ojou + + frac=((os/60.+om)/60.+oh)/24. + ojou=dble(ijou)+frac + year=dble(ian) + rmon=dble(imoi) + if (imoi .le. 2) then + year=year-1. + rmon=rmon+12. + endif + cf=year+(rmon/100.)+(ojou/10000.) + if (cf .ge. 1582.1015) then + a=int(year/100) + b=2-a+int(a/4) + else + b=0 + endif + tjd=int(365.25*year)+int(30.6001*(rmon+1))+int(ojou) + + +1720994.5+b + tjdsec=(ojou-int(ojou))+(tjd-int(tjd)) + tjd=int(tjd)+int(tjdsec) + tjdsec=tjdsec-int(tjdsec) + return + end + + Index: trunk/LMDZ.COMMON/libf/misc/minmax.F =================================================================== --- trunk/LMDZ.COMMON/libf/misc/minmax.F (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/minmax.F (revision 1441) @@ -0,0 +1,23 @@ +! +! $Header$ +! + SUBROUTINE minmax(imax, xi, zmin, zmax ) +c +c P. Le Van + + INTEGER imax + REAL xi(imax) + REAL zmin,zmax + INTEGER i + + zmin = xi(1) + zmax = xi(1) + + DO i = 2, imax + zmin = MIN( zmin,xi(i) ) + zmax = MAX( zmax,xi(i) ) + ENDDO + + RETURN + END + Index: trunk/LMDZ.COMMON/libf/misc/minmax2.F =================================================================== --- trunk/LMDZ.COMMON/libf/misc/minmax2.F (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/minmax2.F (revision 1441) @@ -0,0 +1,20 @@ +! +! $Header$ +! + SUBROUTINE minmax2(imax, jmax, lmax, xi, zmin, zmax ) +c + INTEGER lmax,jmax,imax + REAL xi(imax*jmax*lmax) + REAL zmin,zmax + INTEGER i + + zmin = xi(1) + zmax = xi(1) + + DO i = 2, imax*jmax*lmax + zmin = MIN( zmin,xi(i) ) + zmax = MAX( zmax,xi(i) ) + ENDDO + + RETURN + END Index: trunk/LMDZ.COMMON/libf/misc/nrtype.F90 =================================================================== --- trunk/LMDZ.COMMON/libf/misc/nrtype.F90 (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/nrtype.F90 (revision 1441) @@ -0,0 +1,22 @@ +MODULE nrtype + + implicit none + + integer, parameter:: k8 = selected_real_kind(13) + + ! Frequently used mathematical constants (with precision to spare): + + REAL, PARAMETER :: PI=3.141592653589793238462643383279502884197 + REAL, PARAMETER :: PIO2=1.57079632679489661923132169163975144209858 + REAL, PARAMETER :: TWOPI=6.283185307179586476925286766559005768394 + REAL, PARAMETER :: SQRT2=1.41421356237309504880168872420969807856967 + REAL, PARAMETER :: EULER=0.5772156649015328606065120900824024310422 + + REAL(K8), PARAMETER:: & + PI_D = 3.141592653589793238462643383279502884197_k8 + REAL(K8), PARAMETER:: & + PIO2_D=1.57079632679489661923132169163975144209858_k8 + REAL(K8), PARAMETER:: & + TWOPI_D=6.283185307179586476925286766559005768394_k8 + +END MODULE nrtype Index: trunk/LMDZ.COMMON/libf/misc/ran1.F =================================================================== --- trunk/LMDZ.COMMON/libf/misc/ran1.F (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/ran1.F (revision 1441) @@ -0,0 +1,38 @@ +! +! $Id: ran1.F 2197 2015-02-09 07:13:05Z emillour $ +! + FUNCTION RAN1(IDUM) + IMPLICIT NONE + REAL RAN1 + REAL,SAVE :: R(97) + REAL,PARAMETER :: RM1=3.8580247E-6,RM2=7.4373773E-6 + INTEGER,SAVE :: IFF=0 + integer,save :: ix1,ix2,ix3 + INTEGER,PARAMETER :: M1=259200,IA1=7141,IC1=54773 + INTEGER,PARAMETER :: M2=134456,IA2=8121,IC2=28411 + INTEGER,PARAMETER :: M3=243000,IA3=4561,IC3=51349 + INTEGER :: IDUM,J + + IF (IDUM.LT.0.OR.IFF.EQ.0) THEN + IFF=1 + IX1=MOD(IC1-IDUM,M1) + IX1=MOD(IA1*IX1+IC1,M1) + IX2=MOD(IX1,M2) + IX1=MOD(IA1*IX1+IC1,M1) + IX3=MOD(IX1,M3) + DO 11 J=1,97 + IX1=MOD(IA1*IX1+IC1,M1) + IX2=MOD(IA2*IX2+IC2,M2) + R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1 +11 CONTINUE + IDUM=1 + ENDIF + IX1=MOD(IA1*IX1+IC1,M1) + IX2=MOD(IA2*IX2+IC2,M2) + IX3=MOD(IA3*IX3+IC3,M3) + J=1+(97*IX3)/M3 + IF(J.GT.97.OR.J.LT.1) stop 1 + RAN1=R(J) + R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1 + RETURN + END Index: trunk/LMDZ.COMMON/libf/misc/sort.F =================================================================== --- trunk/LMDZ.COMMON/libf/misc/sort.F (revision 1441) +++ trunk/LMDZ.COMMON/libf/misc/sort.F (revision 1441) @@ -0,0 +1,37 @@ +! +! $Header$ +! +C +C + SUBROUTINE sort(n,d) +c +c P.Le Van +c +c... cette routine met le tableau d dans l'ordre croissant .... +cc ( pour avoir l'ordre decroissant,il suffit de remplacer l'instruc +c tion situee + bas IF(d(j).LE.p) THEN par +c IF(d(j).GE.p) THEN +c + + INTEGER n + REAL d(n) , p + INTEGER i,j,k + + DO i=1,n-1 + k=i + p=d(i) + DO j=i+1,n + IF(d(j).LE.p) THEN + k=j + p=d(j) + ENDIF + ENDDO + + IF(k.ne.i) THEN + d(k)=d(i) + d(i)=p + ENDIF + ENDDO + + RETURN + END Index: trunk/LMDZ.COMMON/libf/misc/wxios.F90 =================================================================== --- trunk/LMDZ.COMMON/libf/misc/wxios.F90 (revision 1403) +++ trunk/LMDZ.COMMON/libf/misc/wxios.F90 (revision 1441) @@ -93,5 +93,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Routine d'initialisation !!!!!!!!!!!!! - ! A lancer juste après mpi_init !!!!!!!!!!!!! + ! A lancer juste après mpi_init !!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -145,5 +145,5 @@ !Initialisation du contexte: CALL xios_context_initialize(g_ctx_name, g_comm) - CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération + CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération CALL xios_set_current_context(xios_ctx) !Activation g_ctx = xios_ctx @@ -153,20 +153,20 @@ WRITE(lunout,*) " now call xios_solve_inheritance()" ENDIF - !Une première analyse des héritages: + !Une première analyse des héritages: CALL xios_solve_inheritance() END SUBROUTINE wxios_context_init !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Routine de paramétrisation !!!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure) - IMPLICIT NONE - INCLUDE 'iniprint.h' - - !Paramètres: + ! Routine de paramétrisation !!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure) + IMPLICIT NONE + INCLUDE 'iniprint.h' + + !Paramètres: CHARACTER(len=*), INTENT(IN) :: calendrier - INTEGER, INTENT(IN) :: annee, mois, jour - REAL, INTENT(IN) :: pasdetemps, heure + INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour + REAL, INTENT(IN) :: pasdetemps, heure, ini_heure !Variables: @@ -181,5 +181,5 @@ mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps) - !Réglage du calendrier: + !Réglage du calendrier: SELECT CASE (calendrier) CASE('earth_360d') @@ -197,10 +197,18 @@ END SELECT - !Formatage de la date de départ: - WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour - - IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date - - CALL xios_set_context_attr_hdl(g_ctx, start_date= date) + !Formatage de la date d'origine: + WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure) + + IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date + + CALL xios_set_context_attr_hdl(g_ctx, time_origin = date) + + !Formatage de la date de debut: + + WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure) + + IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date + + CALL xios_set_context_attr_hdl(g_ctx, start_date = date) !Et enfin,le pas de temps: @@ -253,8 +261,8 @@ LOGICAL :: boool - !Masque pour les problèmes de recouvrement MPI: + !Masque pour les problèmes de recouvrement MPI: LOGICAL :: mask(ni,nj) - !On récupère le handle: + !On récupère le handle: CALL xios_get_domain_handle(dom_id, dom) @@ -285,5 +293,5 @@ CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool) - !Vérification: + !Vérification: IF (xios_is_valid_domain(dom_id)) THEN IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool @@ -294,5 +302,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Pour déclarer un axe vertical !!!!!!!!!!!!!!! + ! Pour déclarer un axe vertical !!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value) @@ -315,8 +323,8 @@ ! axis_id=trim(axisgroup_id) - !On récupère le groupe d'axes qui va bien: + !On récupère le groupe d'axes qui va bien: !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup) - !On ajoute l'axe correspondant à ce fichier: + !On ajoute l'axe correspondant à ce fichier: !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id))) @@ -327,5 +335,5 @@ CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value) - !Vérification: + !Vérification: IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id)) @@ -338,5 +346,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!! + ! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE wxios_add_file(fname, ffreq, flvl) @@ -352,11 +360,11 @@ CHARACTER(len=100) :: nffreq - !On regarde si le fichier n'est pas défini par XML: + !On regarde si le fichier n'est pas défini par XML: IF (.NOT.xios_is_valid_file(fname)) THEN - !On créé le noeud: + !On créé le noeud: CALL xios_get_filegroup_handle("defile", x_fg) CALL xios_add_file(x_fg, x_file, fname) - !On reformate la fréquence: + !On reformate la fréquence: CALL reformadate(ffreq, nffreq) @@ -376,5 +384,5 @@ ELSE IF (prt_level >= 10) THEN - WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML." + WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML." ENDIF ! Ehouarn: add an enable=.true. on top of xml definitions... why??? @@ -384,5 +392,5 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Pour créer un champ !!!!!!!!!!!!!!!!!!!! + ! Pour créer un champ !!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit) @@ -401,5 +409,5 @@ REAL(KIND=8) :: def - !La valeur par défaut des champs non définis: + !La valeur par défaut des champs non définis: def = nf90_fill_real @@ -414,5 +422,5 @@ !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit - !On rentre ses paramètres: + !On rentre ses paramètres: CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def) IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:" @@ -422,7 +430,7 @@ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Pour déclarer un champ !!!!!!!!!!!!!!!!! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op) + ! Pour déclarer un champ !!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert) IMPLICIT NONE INCLUDE 'iniprint.h' @@ -437,4 +445,5 @@ CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous... + CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert CHARACTER(len=100) :: operation TYPE(xios_file) :: f @@ -451,6 +460,11 @@ axis_id="plev" ENDIF - - !on prépare le nom de l'opération: + + IF (PRESENT(nam_axvert)) THEN + axis_id=nam_axvert + print*,'nam_axvert=',axis_id + ENDIF + + !on prépare le nom de l'opération: operation = reformaop(op) @@ -463,7 +477,7 @@ ENDIF - !On regarde si le champ à déjà été créé ou non: + !On regarde si le champ à déjà été créé ou non: IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN - !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire + !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML" g_flag_xml = .TRUE. @@ -471,9 +485,9 @@ ELSE IF (.NOT. g_field_name == fieldname) THEN - !Si premier pssage et champ indéfini, alors on le créé + !Si premier pssage et champ indéfini, alors on le créé IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist" - !On le créé: + !On le créé: CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit) IF (xios_is_valid_field(fieldname)) THEN @@ -487,5 +501,5 @@ IF (.NOT. g_flag_xml) THEN - !Champ existe déjà, mais pas XML, alors on l'ajoute + !Champ existe déjà, mais pas XML, alors on l'ajoute !On ajoute le champ: CALL xios_get_file_handle(fname, f) @@ -497,5 +511,5 @@ - !On rentre ses paramètres: + !On rentre ses paramètres: CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.) @@ -550,5 +564,5 @@ SUBROUTINE wxios_closedef() CALL xios_close_context_definition() - CALL xios_update_calendar(0) +! CALL xios_update_calendar(0) END SUBROUTINE wxios_closedef @@ -559,3 +573,2 @@ END MODULE wxios #endif -