Index: trunk/LMDZ.COMMON/libf/bibio/wxios.F90
===================================================================
--- trunk/LMDZ.COMMON/libf/bibio/wxios.F90	(revision 1019)
+++ trunk/LMDZ.COMMON/libf/bibio/wxios.F90	(revision 1019)
@@ -0,0 +1,425 @@
+! $Id: wxios.F90 $
+#ifdef CPP_XIOS
+MODULE wxios
+    USE xios
+    USE iaxis
+    USE iaxis_attr
+    USE icontext_attr
+    USE idate
+    USE idomain_attr
+    USE ifield_attr
+    USE ifile_attr
+    USE ixml_tree
+
+    !Variables disponibles pendant toute l'execution du programme:
+    
+    INTEGER, SAVE :: g_comm
+    CHARACTER(len=100), SAVE :: g_ctx_name
+    TYPE(xios_context), SAVE :: g_ctx
+!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
+
+    CONTAINS
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   str + i   =>   str_i   !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    SUBROUTINE concat(str, i, str_i) !MAX i = 99
+        CHARACTER(len=*), INTENT(IN) :: str
+        INTEGER, INTENT(IN) :: i
+        CHARACTER(len=100), INTENT(OUT) :: str_i
+        
+        
+        !INT -> CHAR:
+        CHARACTER(len=10) :: num
+        WRITE(num, "(I5)") i
+        str_i = TRIM(ADJUSTL(str//"_"//TRIM(ADJUSTL(num))))
+        
+    END SUBROUTINE concat
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    SUBROUTINE reformadate(odate, ndate)
+        CHARACTER(len=*), INTENT(IN) :: odate
+        CHARACTER(len=100), INTENT(OUT) :: ndate
+        
+        INTEGER :: i = 0
+        
+        i = INDEX(odate, "day")
+        IF (i > 0) THEN
+            ndate = odate(1:i-1)//"d"
+        ELSE
+            i = INDEX(odate, "hr")
+            IF (i > 0) THEN
+                ndate = odate(1:i-1)//"h"
+            ELSE
+                ndate = odate
+            END IF
+        END IF
+        
+        !WRITE(*,*) "Xios. ", odate, " => ", ndate
+    END SUBROUTINE reformadate
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    !   ave(X) => average etc     !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    
+    CHARACTER(len=7) FUNCTION reformaop(op)
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        INTEGER :: i = 0
+        reformaop = "average"
+        
+        IF (op.EQ."inst(X)") THEN
+            reformaop = "instant"
+        END IF
+        
+        IF (op.EQ."once") THEN
+            reformaop = "once"
+        END IF
+        
+        IF (op.EQ."t_max(X)") THEN
+            reformaop = "maximum"
+        END IF
+        
+        IF (op.EQ."t_min(X)") THEN
+            reformaop = "minimum"
+        END IF
+        
+        !WRITE(*,*) "Xios. ", op, " => ", reformaop
+    END FUNCTION reformaop
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine d'initialisation      !!!!!!!!!!!!!
+    !     A lancer juste aprÃ¨s mpi_init !!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_init(xios_ctx_name)
+      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
+        
+      INTEGER :: xios_comm
+        TYPE(xios_context) :: xios_ctx
+      
+        WRITE(*,*) "Xios. Initialization"
+
+        !Lancement de xios:
+        CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
+        
+        !Initialisation du contexte:
+        CALL xios_context_initialize(xios_ctx_name, xios_comm)
+        CALL xios_get_handle(xios_ctx_name, xios_ctx)    !RÃ©cupÃ©ration
+        CALL xios_set_current_context(xios_ctx)            !Activation
+        
+        !Enregistrement des variables globales:
+        g_comm = xios_comm
+        g_ctx_name = xios_ctx_name
+        g_ctx = xios_ctx
+        
+        WRITE(*,*) "Xios. Current context is ", xios_ctx_name
+    END SUBROUTINE wxios_init
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Routine de paramÃ©trisation !!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
+     !ParamÃ¨tres:
+     CHARACTER(len=*), INTENT(IN) :: calendrier
+     INTEGER, INTENT(IN) :: annee, mois, jour
+     REAL, INTENT(IN) :: pasdetemps, heure
+     
+     !Variables:
+     CHARACTER(len=80) :: abort_message
+     CHARACTER(len=19) :: date
+     INTEGER :: njour = 1
+     
+     !Variables pour xios:
+     TYPE(xios_time) :: mdtime
+     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
+     
+        mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
+
+        !RÃ©glage du calendrier:
+        SELECT CASE (calendrier)
+            CASE('earth_360d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
+                WRITE(*,*) 'Xios. Calendrier terrestre a 360 jours/an'
+            CASE('earth_365d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
+                WRITE(*,*) 'Xios. Calendrier terrestre a 365 jours/an'
+            CASE('earth_366d')
+                CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
+                WRITE(*,*) 'Xios. Calendrier gregorien'
+            CASE DEFAULT
+                abort_message = 'Xios. Mauvais choix de calendrier'
+                CALL abort_gcm('Gcm:Xios',abort_message,1)
+        END SELECT
+        
+        !Formatage de la date de dÃ©part:
+        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
+        
+        WRITE(*,*) "Xios. Initial time: ", date
+        
+        CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
+        
+        !Et enfin,le pas de temps:
+        CALL xios_set_timestep(mdtime)
+        WRITE(*,*) "Xios. ts=",mdtime
+    END SUBROUTINE wxios_set_cal
+
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_domain_param(dom_id, is_sequential, iim, jjm, io_lat, io_lon)
+         
+        CHARACTER (len=*), INTENT(IN) :: dom_id
+        LOGICAL, INTENT(IN) :: is_sequential
+        INTEGER, INTENT(IN) :: iim, jjm
+        REAL, DIMENSION(:) :: io_lat, io_lon
+        
+        
+        TYPE(xios_domain) :: dom
+        INTEGER :: ni, nj, ni_glo, nj_glo, ibegin, iend, jbegin, jend
+        LOGICAl :: boool
+        
+        ni_glo = iim
+        nj_glo = jjm
+        ni = iim
+        nj = jjm
+        ibegin = 1
+        jbegin = 1
+        iend = ibegin + ni - 1
+        jend = jbegin + nj - 1
+        
+        !On rÃ©cupÃ¨re le handle:
+        CALL xios_get_domain_handle(dom_id, dom)
+        
+        WRITE(*,*) "Xios. ni:",iim," ni_glo:", iim, " nj:", jjm, " nj_glo:", jjm
+        WRITE(*,*) "Xios. Size lon:", SIZE(io_lon), " lat:", SIZE(io_lat)
+        
+        !On parametrise le domaine:
+        !IF (is_sequential) THEN
+            CALL xios_set_domain_attr_hdl(dom, ni_glo=iim, ibegin=1, ni=iim,&
+            & nj_glo=jjm, jbegin=1,nj=jjm,&
+            & lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
+        !END IF
+         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
+        !VÃ©rification:
+        IF (xios_is_valid_domain(dom_id)) THEN
+            WRITE(*,*) "Xios. Domain initialized: ", dom_id, boool
+        ELSE
+            WRITE(*,*) "Xios. Invalid domain: ", dom_id
+        END IF
+    END SUBROUTINE wxios_domain_param
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un axe vertical !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file_id, axis_size, axis_value)
+        CHARACTER (len=*), INTENT(IN) :: axisgroup_id
+        INTEGER, INTENT(IN) :: axis_file_id, axis_size
+        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
+        
+        TYPE(xios_axisgroup) :: axgroup
+        TYPE(xios_axis) :: ax
+        CHARACTER(len=100) :: axis_id
+        
+        
+        !PrÃ©paration du nom de l'axe:
+        CALL concat(axisgroup_id, axis_file_id, axis_id)
+        
+        !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:
+        CALL xios_add_axis(axgroup, ax, axis_id)
+        
+        !Et on le parametrise:
+        CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
+        
+        !VÃ©rification:
+        IF (xios_is_valid_axis(axis_id)) THEN
+            WRITE(*,*) "Xios. Axis created: ", axis_id
+        ELSE
+            WRITE(*,*) "Xios. Invalid axis: ", axis_id
+        END IF
+
+    END SUBROUTINE wxios_add_vaxis
+    
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un fichier  !!!!!!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: ffreq
+        INTEGER, INTENT(IN) :: flvl
+        
+        TYPE(xios_file) :: x_file
+        TYPE(xios_filegroup) :: x_fg
+        CHARACTER(len=100) :: nffreq
+        
+        !On crÃ©Ã© le noeud:
+        CALL xios_get_filegroup_handle("defile", x_fg)
+        CALL xios_add_file(x_fg, x_file, "X"//fname)
+        
+        !On reformate la frÃ©quence:
+        CALL reformadate(ffreq, nffreq)
+        
+        !On configure:
+        CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
+                output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
+        
+        IF (xios_is_valid_file("X"//fname)) THEN
+            WRITE(*,*) "Xios. New file: ", "X"//fname
+            WRITE(*,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+        ELSE
+            WRITE(*,*) "Xios. Error, invalid file: ", "X"//fname
+            WRITE(*,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+        END IF
+    END SUBROUTINE wxios_add_file
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour crÃ©er un champ      !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
+        USE netcdf
+        
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        
+        TYPE(xios_field) :: field
+        CHARACTER(len=10) :: newunit
+        REAL(KIND=8) :: def
+        
+        !La valeur par dÃ©faut des champs non dÃ©finis:
+        def = nf90_fill_real
+        
+        IF (fieldunit .EQ. " ") THEN
+            newunit = "-"
+        ELSE
+            newunit = fieldunit
+        ENDIF
+        
+        !On ajoute le champ:
+        CALL xios_add_field(fieldgroup, field, fieldname)
+        !WRITE(*,*) "Xios. ",fieldname,fieldgroup, fieldlongname, fieldunit
+        
+        !On rentre ses paramÃ¨tres:
+        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
+        WRITE(*,*) "Xios. Champ ", fieldname, "cree:"
+        WRITE(*,*) "Xios. long_name=",fieldlongname,"; unit=",newunit,";  default_value=",nf90_fill_real
+
+    END SUBROUTINE wxios_add_field
+    
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! Pour dÃ©clarer un champ      !!!!!!!!!!!!!!!
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        INTEGER, INTENT(IN)          :: fdim, fid
+        CHARACTER(len=*), INTENT(IN) :: fname
+        CHARACTER(len=*), INTENT(IN) :: fieldlongname
+        CHARACTER(len=*), INTENT(IN) :: fieldunit
+        INTEGER, INTENT(IN)          :: field_level
+        CHARACTER(len=*), INTENT(IN) :: op
+        
+        CHARACTER(len=100) :: axis_id
+        CHARACTER(len=100) :: operation
+        TYPE(xios_file) :: f
+        TYPE(xios_field) :: field
+        TYPE(xios_fieldgroup) :: fieldgroup
+        
+        
+        !PrÃ©paration du nom de l'axe:
+        CALL concat("presnivs", fid, axis_id)
+        
+        !on prÃ©pare le nom de l'opÃ©ration:
+        operation = reformaop(op)
+        
+        
+        
+        !On selectionne le bon groupe de champs:
+        IF (fdim.EQ.2) THEN
+            CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
+        ELSE
+          CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
+        ENDIF
+        
+        !On regarde si le champ Ã  dÃ©jÃ  Ã©tÃ© crÃ©Ã© ou non:
+        IF (xios_is_valid_field(fieldname)) THEN
+            WRITE(*,*) "Xios. Champ ", fieldname, "existe"
+        ELSE
+            WRITE(*,*) "Xios. Champ ", fieldname, "nexiste pas"
+            
+            !On le crÃ©Ã©:
+            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
+            IF (xios_is_valid_field(fieldname)) THEN
+                WRITE(*,*) "Xios. Champ ", fieldname, "cree"
+            ENDIF
+        ENDIF
+        
+        !On ajoute le champ:
+        CALL xios_get_file_handle("X"//fname, f)
+        CALL xios_add_fieldtofile(f, field)
+        
+        
+        !L'operation, sa frequence:
+        CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
+
+        
+        !On rentre ses paramÃ¨tres:
+        CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
+        
+        IF (fdim.EQ.2) THEN
+            !Si c'est un champ 2D:
+            WRITE(*,*) "Xios. Champ 2D ", fieldname, " de ", "X"//fname ," configure:"
+            WRITE (*,*) "Xios. op=", TRIM(ADJUSTL(operation))
+            WRITE(*,*) "Xios. freq_op=1ts","; lvl=",field_level
+        ELSE
+            !Si 3D :
+            !On ajoute l'axe vertical qui va bien:
+            CALL xios_set_field_attr_hdl(field, axis_ref=axis_id)
+            
+            WRITE(*,*) "Xios. Champ 3D ", fieldname, " de ", "X"//fname, "configure:"
+            WRITE(*,*) "Xios. freq_op=1ts","; lvl=",field_level
+            WRITE(*,*) "Xios. axe=",axis_id
+        END IF
+        
+    END SUBROUTINE wxios_add_field_to_file
+    
+    SUBROUTINE wxios_update_calendar(ito)
+        INTEGER, INTENT(IN) :: ito
+        CALL xios_update_calendar(ito)
+    END SUBROUTINE wxios_update_calendar
+    
+    SUBROUTINE wxios_write_2D(fieldname, fdata)
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
+        
+        CALL xios_send_field(fieldname, fdata)
+    END SUBROUTINE wxios_write_2D
+    
+    SUBROUTINE wxios_write_3D(fieldname, fdata)
+        CHARACTER(len=*), INTENT(IN) :: fieldname
+        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
+        
+        CALL xios_send_field(fieldname, fdata)
+    END SUBROUTINE wxios_write_3D
+    
+    SUBROUTINE wxios_closedef()
+        CALL xios_close_context_definition()
+        CALL xios_update_calendar(0)
+    END SUBROUTINE wxios_closedef
+    
+    SUBROUTINE wxios_close()
+        CALL xios_context_finalize()
+         CALL xios_finalize()
+     END SUBROUTINE wxios_close
+END MODULE wxios
+#endif
+
