Index: LMDZ5/branches/testing/libf/phylmd/iophy.F90
===================================================================
--- LMDZ5/branches/testing/libf/phylmd/iophy.F90	(revision 2669)
+++ LMDZ5/branches/testing/libf/phylmd/iophy.F90	(revision 2870)
@@ -45,16 +45,16 @@
 
   SUBROUTINE init_iophy_new(rlat,rlon)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: gather, bcast, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
                                 jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
                                 mpi_size, mpi_rank, klon_mpi, &
                                 is_sequential, is_south_pole_dyn
-  USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
+  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
   USE print_control_mod, ONLY: prt_level,lunout 
 #ifdef CPP_IOIPSL
-  USE ioipsl, only: flio_dom_set
-#endif
-#ifdef CPP_XIOS
-  use wxios, only: wxios_domain_param
+  USE ioipsl, ONLY: flio_dom_set
+#endif
+#ifdef CPP_XIOS
+  USE wxios, ONLY: wxios_domain_param
 #endif
   IMPLICIT NONE
@@ -136,5 +136,5 @@
     ELSE 
         data_ibegin = ii_begin - 1
-    END IF
+    ENDIF
 
     IF (mpi_rank == mpi_size-1) THEN
@@ -142,7 +142,7 @@
     ELSE
         data_iend = ii_end + 1
-    END IF
-
-    if (prt_level>=10) then
+    ENDIF
+
+    IF (prt_level>=10) THEN
       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
@@ -150,5 +150,5 @@
       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
-    endif
+    ENDIF
 
     ! Initialize the XIOS domain coreesponding to this process:
@@ -163,7 +163,7 @@
 
   SUBROUTINE init_iophy(lat,lon)
-  USE mod_phys_lmdz_para, only: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
+  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
                                 mpi_size, mpi_rank 
-  USE ioipsl, only: flio_dom_set
+  USE ioipsl, ONLY: flio_dom_set
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
   IMPLICIT NONE
@@ -180,7 +180,7 @@
 
 !$OMP MASTER  
-    allocate(io_lat(nbp_lat))
+    ALLOCATE(io_lat(nbp_lat))
     io_lat(:)=lat(:)
-    allocate(io_lon(nbp_lon))
+    ALLOCATE(io_lon(nbp_lon))
     io_lon(:)=lon(:)
    
@@ -191,9 +191,9 @@
     dpl=(/ nbp_lon, jj_end /)
     dhs=(/ ii_begin-1,0 /)
-    if (mpi_rank==mpi_size-1) then
+    IF (mpi_rank==mpi_size-1) THEN
       dhe=(/0,0/)
-    else
+    ELSE
       dhe=(/ nbp_lon-ii_end,0 /)  
-    endif
+    ENDIF
     
 #ifndef CPP_IOIPSL_NO_OUTPUT 
@@ -203,35 +203,35 @@
 !$OMP END MASTER
       
-  end SUBROUTINE init_iophy
+  END SUBROUTINE init_iophy
 
  SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
 !  USE dimphy
-  USE mod_phys_lmdz_para, only: is_sequential, is_using_mpi, is_mpi_root, &
+  USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
                                 jj_begin, jj_end, jj_nb
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  use ioipsl, only: histbeg
-#ifdef CPP_XIOS
-  use wxios, only: wxios_add_file
+  USE ioipsl, ONLY: histbeg
+#ifdef CPP_XIOS
+  USE wxios, ONLY: wxios_add_file
 #endif
   IMPLICIT NONE
   include 'clesphys.h'
     
-    character*(*), INTENT(IN) :: name
-    integer, INTENT(IN) :: itau0
+    CHARACTER*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau0
     REAL,INTENT(IN) :: zjulian
     REAL,INTENT(IN) :: dtime
-    character(LEN=*), INTENT(IN) :: ffreq
+    CHARACTER(LEN=*), INTENT(IN) :: ffreq
     INTEGER,INTENT(IN) :: lev
-    integer,intent(out) :: nhori
-    integer,intent(out) :: nid_day
+    INTEGER,INTENT(OUT) :: nhori
+    INTEGER,INTENT(OUT) :: nid_day
 
 !$OMP MASTER    
-    if (is_sequential) then
+    IF (is_sequential) THEN
       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
-    else
+    ELSE
       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
-    endif
+    ENDIF
 
 #ifdef CPP_XIOS
@@ -242,5 +242,5 @@
         CALL wxios_add_file(name, ffreq, lev)
       ENDIF
-    END IF
+    ENDIF
 #endif
 !$OMP END MASTER
@@ -250,26 +250,26 @@
   SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
 
-  USE mod_phys_lmdz_para, only: jj_begin, jj_end, jj_nb, is_sequential
+  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  use ioipsl, only: histbeg
+  USE ioipsl, ONLY: histbeg
 
   IMPLICIT NONE
     
-    character*(*), INTENT(IN) :: name
-    integer, INTENT(IN) :: itau0
+    CHARACTER*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau0
     REAL,INTENT(IN) :: zjulian
     REAL,INTENT(IN) :: dtime
-    integer,intent(out) :: nhori
-    integer,intent(out) :: nid_day
+    INTEGER,INTENT(OUT) :: nhori
+    INTEGER,INTENT(OUT) :: nid_day
 
 !$OMP MASTER    
 #ifndef CPP_IOIPSL_NO_OUTPUT 
-    if (is_sequential) then
+    IF (is_sequential) THEN
       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
-    else
+    ELSE
       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
-    endif
+    ENDIF
 #endif
 !$OMP END MASTER
@@ -281,10 +281,10 @@
              plon,plat,plon_bounds,plat_bounds, &
              nname,itau0,zjulian,dtime,nnhori,nnid_day)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: gather, bcast, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 mpi_rank
-  USE mod_grid_phy_lmdz, only: klon_glo, nbp_lon, nbp_lat
-  use ioipsl, only: histbeg
+  USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat
+  USE ioipsl, ONLY: histbeg
 
   IMPLICIT NONE
@@ -292,12 +292,12 @@
     REAL,DIMENSION(klon),INTENT(IN) :: rlon
     REAL,DIMENSION(klon),INTENT(IN) :: rlat
-    integer, INTENT(IN) :: itau0
+    INTEGER, INTENT(IN) :: itau0
     REAL,INTENT(IN) :: zjulian
     REAL,INTENT(IN) :: dtime
-    integer, INTENT(IN) :: pim
-    integer, intent(out) :: nnhori
-    character(len=20), INTENT(IN) :: nname
-    INTEGER, intent(out) :: nnid_day
-    integer :: i
+    INTEGER, INTENT(IN) :: pim
+    INTEGER, intent(out) :: nnhori
+    CHARACTER(len=20), INTENT(IN) :: nname
+    INTEGER, INTENT(OUT) :: nnid_day
+    INTEGER :: i
     REAL,DIMENSION(klon_glo)        :: rlat_glo
     REAL,DIMENSION(klon_glo)        :: rlon_glo
@@ -328,14 +328,14 @@
      plon_bounds(i,1)=rlon_glo(tabij(i)-1)
      plon_bounds(i,2)=rlon_glo(tabij(i)+1)
-     if(plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
-      if(rlon_glo(tabij(i)).GE.0.) THEN
+     IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
+      IF (rlon_glo(tabij(i)).GE.0.) THEN
        plon_bounds(i,2)=-1*plon_bounds(i,2)
-      endif
-     endif
-     if(plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
-      if(rlon_glo(tabij(i)).LE.0.) THEN
+      ENDIF
+     ENDIF
+     IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
+      IF (rlon_glo(tabij(i)).LE.0.) THEN
        plon_bounds(i,2)=-1*plon_bounds(i,2)
-      endif
-     endif
+      ENDIF
+     ENDIF
 !
      IF ( tabij(i).LE.nbp_lon) THEN
@@ -361,10 +361,10 @@
 
        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)
-       if ((nbp_lon*nbp_lat).gt.1) then
+       IF ((nbp_lon*nbp_lat).GT.1) THEN
        DO i = 1, nbp_lon
          zx_lon(i,1) = rlon_glo(i+1)
          zx_lon(i,nbp_lat) = rlon_glo(i+1)
        ENDDO
-       endif
+       ENDIF
        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)
 
@@ -375,25 +375,25 @@
      plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
 
-     if (ipt(i).EQ.1) then
+     IF (ipt(i).EQ.1) THEN
       plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
       plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
-     endif
+     ENDIF
  
-     if (ipt(i).EQ.nbp_lon) then
+     IF (ipt(i).EQ.nbp_lon) THEN
       plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
-     endif
+     ENDIF
 
      plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
      plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
 
-     if (jpt(i).EQ.1) then
+     IF (jpt(i).EQ.1) THEN
       plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
       plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
-     endif
+     ENDIF
  
-     if (jpt(i).EQ.nbp_lat) then
+     IF (jpt(i).EQ.nbp_lat) THEN
       plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
       plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
-     endif
+     ENDIF
 !
 !    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) 
@@ -407,5 +407,5 @@
                            itau0, zjulian, dtime, nnhori, nnid_day)
 #endif
-    else
+    ELSE
      npproc=0
      DO ip=1, pim
@@ -448,17 +448,19 @@
                             itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
 #endif
-    endif
+    ENDIF
 !$OMP END MASTER
 
-  end SUBROUTINE histbeg_phy_points
+  END SUBROUTINE histbeg_phy_points
 
 
   SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
 
-    USE ioipsl, only: histdef
-    USE mod_phys_lmdz_para, only: jj_nb
-    use phys_output_var_mod, only: type_ecri, zoutm, zdtime_moy, lev_files, &
-                                   nid_files, nhorim, swaero_diag, nfiles
+    USE ioipsl, ONLY: histdef
+    USE mod_phys_lmdz_para, ONLY: jj_nb
+    USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
+                                   nid_files, nhorim, swaero_diag, dryaod_diag, nfiles
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
+    USE aero_mod, ONLY : naero_tot, name_aero_tau
+
     IMPLICIT NONE
 
@@ -466,7 +468,8 @@
 
     INTEGER                          :: iff
+    INTEGER                          :: naero
     LOGICAL                          :: lpoint
     INTEGER, DIMENSION(nfiles)       :: flag_var
-    CHARACTER(LEN=20)                 :: nomvar
+    CHARACTER(LEN=20)                :: nomvar
     CHARACTER(LEN=*)                 :: titrevar
     CHARACTER(LEN=*)                 :: unitvar
@@ -498,19 +501,28 @@
 
     ! Set swaero_diag=true if at least one of the concerned variables are defined 
-    IF (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN
-       IF  ( flag_var(iff)<=lev_files(iff) ) THEN
-          swaero_diag=.TRUE.
-       END IF
-    END IF
+    IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. & 
+        nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. & 
+        nomvar=='topswai' .OR. nomvar=='solswai' ) THEN 
+       IF  ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
+    ENDIF
+
+    ! Set dryaod_diag=true if at least one of the concerned variables are defined 
+    IF (nomvar=='dryod550aer') THEN
+      IF  ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
+    ENDIF
+    DO naero = 1, naero_tot-1
+      IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
+        IF  ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
+      ENDIF
+    ENDDO
+
   END SUBROUTINE histdef2d_old
 
-
-
   SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
 
-    USE ioipsl, only: histdef
-    USE dimphy, only: klev
-    USE mod_phys_lmdz_para, only: jj_nb
-    use phys_output_var_mod, only: type_ecri, zoutm, lev_files, nid_files, &
+    USE ioipsl, ONLY: histdef
+    USE dimphy, ONLY: klev
+    USE mod_phys_lmdz_para, ONLY: jj_nb
+    USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
                                    nhorim, zdtime_moy, levmin, levmax, &
                                    nvertm, nfiles
@@ -555,22 +567,16 @@
   END SUBROUTINE histdef3d_old
 
-
-
-
-
-
-
-
   SUBROUTINE histdef2d (iff,var)
 
-    USE ioipsl, only: histdef
-    USE mod_phys_lmdz_para, only: jj_nb
-    use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
+    USE ioipsl, ONLY: histdef
+    USE mod_phys_lmdz_para, ONLY: jj_nb
+    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
                                    clef_stations, phys_out_filenames, lev_files, &
-                                   nid_files, nhorim, swaero_diag
+                                   nid_files, nhorim, swaero_diag, dryaod_diag
     USE print_control_mod, ONLY: prt_level,lunout 
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-#ifdef CPP_XIOS
-    use wxios, only: wxios_add_field_to_file
+    USE aero_mod, ONLY : naero_tot, name_aero_tau
+#ifdef CPP_XIOS
+    USE wxios, ONLY: wxios_add_field_to_file
 #endif
     IMPLICIT NONE
@@ -579,9 +585,9 @@
 
     INTEGER                          :: iff
+    INTEGER                          :: naero
     TYPE(ctrl_out)                   :: var
 
     REAL zstophym
     CHARACTER(LEN=20) :: typeecrit
-
 
     ! ug On récupère le type écrit de la structure:
@@ -638,6 +644,5 @@
     ENDIF
 
-    ! Set swaero_diag=true if at least one of the concerned variables are
-    ! defined
+    ! Set swaero_diag=true if at least one of the concerned variables are defined
     !--OB 30/05/2016 use wider set of variables
     IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
@@ -645,23 +650,32 @@
          var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
          var%name=='toplwai' .OR. var%name=='sollwai'  ) ) ) THEN
-       IF  ( var%flag(iff)<=lev_files(iff) ) THEN
-          swaero_diag=.TRUE.
-       END IF
-    END IF
+       IF  ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
+    ENDIF
+
+    ! set dryaod_dry=true if at least one of the concerned variables are defined
+    IF (var%name=='dryod550aer') THEN 
+      IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
+    ENDIF
+    !
+    DO naero = 1, naero_tot-1 
+      IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
+        IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
+      ENDIF
+    ENDDO
   END SUBROUTINE histdef2d
 
   SUBROUTINE histdef3d (iff,var)
 
-    USE ioipsl, only: histdef
-    USE dimphy, only: klev
-    USE mod_phys_lmdz_para, only: jj_nb
-    use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
+    USE ioipsl, ONLY: histdef
+    USE dimphy, ONLY: klev
+    USE mod_phys_lmdz_para, ONLY: jj_nb
+    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
                                    clef_stations, phys_out_filenames, lev_files, &
-                                   nid_files, nhorim, swaero_diag, levmin, &
+                                   nid_files, nhorim, swaero_diag, dryaod_diag, levmin, &
                                    levmax, nvertm
     USE print_control_mod, ONLY: prt_level,lunout
     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
 #ifdef CPP_XIOS
-    use wxios, only: wxios_add_field_to_file
+    USE wxios, ONLY: wxios_add_field_to_file
 #endif
     IMPLICIT NONE
@@ -735,6 +749,6 @@
 !!! Lecture des noms et niveau de sortie des variables dans output.def
     !   en utilisant les routines getin de IOIPSL  
-    use ioipsl, only: getin
-    use phys_output_var_mod, only: nfiles
+    USE ioipsl, ONLY: getin
+    USE phys_output_var_mod, ONLY: nfiles
     USE print_control_mod, ONLY: prt_level,lunout
     IMPLICIT NONE
@@ -750,20 +764,19 @@
   END SUBROUTINE conf_physoutputs
 
-
  
   SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
-  USE ioipsl, only: histwrite
+  USE ioipsl, ONLY: histwrite
   USE print_control_mod, ONLY: prt_level,lunout
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
   IMPLICIT NONE
     
-    integer,INTENT(IN) :: nid
-    logical,INTENT(IN) :: lpoint 
-    character*(*), INTENT(IN) :: name
-    integer, INTENT(IN) :: itau
+    INTEGER,INTENT(IN) :: nid
+    LOGICAL,INTENT(IN) :: lpoint 
+    CHARACTER*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau
     REAL,DIMENSION(:),INTENT(IN) :: field
     REAL,DIMENSION(klon_mpi) :: buffer_omp
@@ -771,7 +784,6 @@
     REAL :: Field2d(nbp_lon,jj_nb)
 
-    integer :: ip
-    REAL,allocatable,DIMENSION(:) :: fieldok
-
+    INTEGER :: ip
+    REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
 
     IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
@@ -786,9 +798,9 @@
      CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-    else
+    ELSE
      ALLOCATE(fieldok(npstn))
      ALLOCATE(index2d(npstn))
 
-     if(is_sequential) then
+     IF (is_sequential) THEN
 !     klon_mpi_begin=1
 !     klon_mpi_end=klon
@@ -796,5 +808,5 @@
        fieldok(ip)=buffer_omp(nptabij(ip))
       ENDDO
-     else
+     ELSE
       DO ip=1, npstn
 !     print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
@@ -804,31 +816,31 @@
        ENDIF
       ENDDO
-     endif
+     ENDIF
      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
      CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
 !
-    endif
-    deallocate(index2d)
-    deallocate(fieldok)
+    ENDIF
+    DEALLOCATE(index2d)
+    DEALLOCATE(fieldok)
 !$OMP END MASTER   
 
  
-  end SUBROUTINE histwrite2d_phy_old
+  END SUBROUTINE histwrite2d_phy_old
 
   SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  use ioipsl, only: histwrite
+  USE ioipsl, ONLY: histwrite
   USE print_control_mod, ONLY: prt_level,lunout
   IMPLICIT NONE
     
-    integer,INTENT(IN) :: nid
-    logical,INTENT(IN) :: lpoint
-    character*(*), INTENT(IN) :: name
-    integer, INTENT(IN) :: itau
+    INTEGER,INTENT(IN) :: nid
+    LOGICAL,INTENT(IN) :: lpoint
+    CHARACTER*(*), INTENT(IN) :: name
+    INTEGER, INTENT(IN) :: itau
     REAL,DIMENSION(:,:),INTENT(IN) :: field  ! --> field(klon,:)
     REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
@@ -845,5 +857,5 @@
 !$OMP MASTER
     CALL grid1Dto2D_mpi(buffer_omp,field3d)
-    if(.NOT.lpoint) THEN
+    IF (.NOT.lpoint) THEN
      ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
      ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
@@ -851,10 +863,10 @@
      CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-   else
+   ELSE
       nlev=size(field,2)
       ALLOCATE(index3d(npstn*nlev))
       ALLOCATE(fieldok(npstn,nlev))
 
-      if(is_sequential) then
+      IF (is_sequential) THEN
 !      klon_mpi_begin=1
 !      klon_mpi_end=klon
@@ -864,5 +876,5 @@
        ENDDO
        ENDDO
-      else
+      ELSE
        DO n=1, nlev
        DO ip=1, npstn
@@ -873,14 +885,14 @@
        ENDDO
        ENDDO
-      endif
+      ENDIF
       IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
       CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
       IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
-    endif 
-  deallocate(index3d)
-  deallocate(fieldok)
+    ENDIF 
+  DEALLOCATE(index3d)
+  DEALLOCATE(fieldok)
 !$OMP END MASTER    
 
-  end SUBROUTINE histwrite3d_phy_old
+  END SUBROUTINE histwrite3d_phy_old
 
 
@@ -889,10 +901,10 @@
 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
   SUBROUTINE histwrite2d_phy(var,field, STD_iff)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
                                 jj_nb, klon_mpi, klon_mpi_begin, &
                                 klon_mpi_end, is_sequential
-  USE ioipsl, only: histwrite
-  use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
+  USE ioipsl, ONLY: histwrite
+  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
                                  nfiles, vars_defined, clef_stations, &
                                  nid_files
@@ -900,5 +912,5 @@
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
 #ifdef CPP_XIOS
-  USE xios, only: xios_send_field
+  USE xios, ONLY: xios_send_field
 #endif
 
@@ -932,15 +944,14 @@
             iff_beg = 1
             iff_end = nfiles
-      END IF
+      ENDIF
 
   ! On regarde si on est dans la phase de définition ou d'écriture:
-  IF(.NOT.vars_defined) THEN
+  IF (.NOT.vars_defined) THEN
 !$OMP MASTER
       !Si phase de définition.... on définit
       IF (.not. ok_all_xml) THEN
-      if (prt_level >= 10) then
-      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
-                     trim(var%name)
-      endif
+      IF (prt_level >= 10) THEN
+      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name)
+      ENDIF
       DO iff=iff_beg, iff_end
          IF (clef_files(iff)) THEN
@@ -955,8 +966,7 @@
     IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1)
     
-    if (prt_level >= 10) then
-      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", &
-                     trim(var%name)
-    endif
+    IF (prt_level >= 10) THEn
+      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
+    ENDIF
     
     CALL Gather_omp(field,buffer_omp)
@@ -969,13 +979,11 @@
       IF (ok_all_xml) THEN
 #ifdef CPP_XIOS
-          if (prt_level >= 10) then
-             write(lunout,*)'Dans iophy histwrite2D,var%name ',&
-                             trim(var%name)                       
-          endif
+          IF (prt_level >= 10) THEN
+             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
+          ENDIF
           CALL xios_send_field(var%name, Field2d)
-          if (prt_level >= 10) then
-             write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
-                             trim(var%name)                       
-          endif
+          IF (prt_level >= 10) THEN
+             WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
+          ENDIF
 #else
         CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
@@ -987,9 +995,8 @@
 #ifdef CPP_XIOS
                IF (firstx) THEN
-                  if (prt_level >= 10) then
-                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
-                                    iff,trim(var%name)                       
-                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
-                  endif
+                  IF (prt_level >= 10) THEN
+                     WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name)                       
+                     WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
+                  ENDIF
                   CALL xios_send_field(var%name, Field2d)
                   firstx=.false.
@@ -997,5 +1004,5 @@
 #endif
 
-                  IF(.NOT.clef_stations(iff)) THEN
+                  IF (.NOT.clef_stations(iff)) THEN
                         ALLOCATE(index2d(nbp_lon*jj_nb))
                         ALLOCATE(fieldok(nbp_lon*jj_nb))
@@ -1029,13 +1036,13 @@
                        ENDIF ! of IF (is_sequential)
 #ifndef CPP_IOIPSL_NO_OUTPUT 
-                       if (prt_level >= 10) then
+                       IF (prt_level >= 10) THEn
                          write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
-                       endif
+                       ENDIF
                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
 #endif
                   ENDIF ! of IF(.NOT.clef_stations(iff))
                   
-                deallocate(index2d)
-                deallocate(fieldok)
+                DEALLOCATE(index2d)
+                DEALLOCATE(fieldok)
             ENDIF !levfiles
         ENDDO ! of DO iff=iff_beg, iff_end
@@ -1049,15 +1056,15 @@
 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
   SUBROUTINE histwrite3d_phy(var, field, STD_iff)
-  USE dimphy, only: klon, klev
-  USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
+  USE dimphy, ONLY: klon, klev
+  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
                                 jj_nb, klon_mpi, klon_mpi_begin, &
                                 klon_mpi_end, is_sequential
-  USE ioipsl, only: histwrite
-  use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
+  USE ioipsl, ONLY: histwrite
+  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
                                  nfiles, vars_defined, clef_stations, &
                                  nid_files
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
 #ifdef CPP_XIOS
-  USE xios, only: xios_send_field
+  USE xios, ONLY: xios_send_field
 #endif
   USE print_control_mod, ONLY: prt_level,lunout
@@ -1088,5 +1095,5 @@
             iff_beg = 1
             iff_end = nfiles
-      END IF
+      ENDIF
 
   ! On regarde si on est dans la phase de définition ou d'écriture:
@@ -1104,9 +1111,9 @@
     IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     nlev=SIZE(field,2)
-    if (nlev.eq.klev+1) then
+    IF (nlev.EQ.klev+1) THEN
         nlevx=klev
-    else
+    ELSE
         nlevx=nlev
-    endif
+    ENDIF
 
     CALL Gather_omp(field,buffer_omp)
@@ -1120,8 +1127,8 @@
       IF (ok_all_xml) THEN
 #ifdef CPP_XIOS
-          if (prt_level >= 10) then
+          IF (prt_level >= 10) THEN
              write(lunout,*)'Dans iophy histwrite3D,var%name ',&
                              trim(var%name)                       
-          endif
+          ENDIF
           CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
 #else
@@ -1135,11 +1142,11 @@
 #ifdef CPP_XIOS
               IF (firstx) THEN
-                if (prt_level >= 10) then
-                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
+                IF (prt_level >= 10) THEn
+                  WRITE (lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
                                   iff,nlev,klev, firstx                       
-                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
+                  WRITE (lunout,*)'histwrite3d_phy: call xios_send_field for ', &
                                   trim(var%name), ' with iim jjm nlevx = ', &
                                   nbp_lon,jj_nb,nlevx
-                endif
+                ENDIF
                 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
                             firstx=.false.
@@ -1185,6 +1192,6 @@
 #endif
                   ENDIF 
-                  deallocate(index3d)
-                  deallocate(fieldok)
+                  DEALLOCATE(index3d)
+                  DEALLOCATE(fieldok)
             ENDIF
       ENDDO
@@ -1199,10 +1206,10 @@
 #ifdef CPP_XIOS
   SUBROUTINE histwrite2d_xios(field_name,field)
-  USE dimphy, only: klon
-  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
+  USE dimphy, ONLY: klon
+  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
-  USE xios, only: xios_send_field
+  USE xios, ONLY: xios_send_field
   USE print_control_mod, ONLY: prt_level,lunout
 
@@ -1259,6 +1266,6 @@
     ENDIF
                   
-    deallocate(index2d)
-    deallocate(fieldok)
+    DEALLOCATE(index2d)
+    DEALLOCATE(fieldok)
 !$OMP END MASTER   
 
@@ -1269,9 +1276,9 @@
 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
   SUBROUTINE histwrite3d_xios(field_name, field)
-  USE dimphy, only: klon, klev
-  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
+  USE dimphy, ONLY: klon, klev
+  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
-  USE xios, only: xios_send_field
+  USE xios, ONLY: xios_send_field
   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
   USE print_control_mod, ONLY: prt_level,lunout
@@ -1330,6 +1337,6 @@
         ENDIF
     ENDIF 
-    deallocate(index3d)
-    deallocate(fieldok)
+    DEALLOCATE(index3d)
+    DEALLOCATE(fieldok)
 !$OMP END MASTER   
 
@@ -1339,5 +1346,5 @@
 #ifdef CPP_XIOS
   SUBROUTINE histwrite0d_xios(field_name, field)
-  USE xios, only: xios_send_field
+  USE xios, ONLY: xios_send_field
   IMPLICIT NONE
 
