source: LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90 @ 5133

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Interface pour ecrire en netcdf avec les routines d'enseignement
! iotd de Frederic Hourdin
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      SUBROUTINE iophys_ecrit(nom,lllm,titre,unite,px)

      USE lmdz_phys_para, ONLY: klon_omp, is_mpi_root
      USE lmdz_phys_transfert_para, ONLY: gather
      USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo
      IMPLICIT NONE



!  Ecriture de variables diagnostiques au choix dans la physique 
!  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
!  3d (ex : temperature), 2d (ex : temperature de surface), ou
!  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
!  solaire)
!  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
!  La periode d'ecriture est donnee par 
!  "ecritphy " regle dans le fichier de controle de run :  run.def

!    writediagfi peut etre appele de n'importe quelle subroutine
!    de la physique, plusieurs fois. L'initialisation et la creation du
!    fichier se fait au tout premier appel.

! WARNING : les variables dynamique (u,v,t,q,ps)
!  sauvees par writediagfi avec une
! date donnee sont legerement differentes que dans le fichier histoire car 
! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
! avant l'ecriture dans diagfi (cf. physiq.F)

! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4

!  parametres (input) :
!  ----------
!      unit : unite logique du fichier de sortie (toujours la meme)
!      nom  : nom de la variable a sortir (chaine de caracteres)
!      titre: titre de la variable (chaine de caracteres)
!      unite : unite de la variable (chaine de caracteres)
!      px : variable a sortir (real 0, 1, 2, ou 3d)

!=================================================================


! Arguments on input:
      INTEGER lllm
      CHARACTER (LEN=*) :: nom,titre,unite
      INTEGER imjmax
      parameter (imjmax=100000)
      REAL px(klon_omp,lllm)
      REAL xglo(klon_glo,lllm)
      REAL zx(nbp_lon,nbp_lat,lllm)



      CALL Gather(px,xglo)
!$OMP MASTER
      IF (is_mpi_root) THEN       
        CALL Grid1Dto2D_glo(xglo,zx)
        CALL iotd_ecrit(nom,lllm,titre,unite,zx)
      ENDIF
!$OMP END MASTER

      RETURN
      end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Version avec reindexation pour appeler depuis les routines internes
! à la sous surface
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


    SUBROUTINE iophys_ecrit_index(nom,lllm,titre,unite,knon,knindex,px)

    USE lmdz_phys_para, ONLY: klon_omp
    USE dimphy, ONLY: klon
    USE lmdz_grid_phy, ONLY: klon_glo
    USE lmdz_abort_physic, ONLY: abort_physic
    IMPLICIT NONE

! This SUBROUTINE returns the sea surface temperature already read from limit.nc

! Arguments on input:
    INTEGER lllm
    CHARACTER (len=*) :: nom,titre,unite
    REAL px(klon_omp,lllm)
    INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
    REAL, DIMENSION(klon,lllm) :: varout

    INTEGER :: i,l

    IF (klon/=klon_omp) THEN
      PRINT*,'klon, klon_omp',klon,klon_omp
      CALL abort_physic('iophys_ecrit','probleme de dimension parallele',1)
    ENDIF

    varout(1:klon,1:lllm)=0.
    DO l = 1, lllm
    DO i = 1, knon
       varout(knindex(i),l) = px(i,l)
    END DO
    END DO
    CALL iophys_ecrit(nom,lllm,titre,unite,varout)

  END SUBROUTINE iophys_ecrit_index

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE iophys_ini(timestep)
      USE lmdz_phys_para, ONLY: is_mpi_root
      USE lmdz_vertical_layers, ONLY: presnivs
      USE lmdz_regular_lonlat, ONLY: lon_reg, lat_reg
      USE dimphy, ONLY: klev
      USE lmdz_grid_phy, ONLY: klon_glo
      USE time_phylmdz_mod, ONLY: annee_ref, day_ref, day_ini
      USE phys_cal_mod, ONLY: calend

      IMPLICIT NONE

      include "YOMCST.h"
!=======================================================================

!   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
!   -------

!   Objet:
!   ------

!   'Initialize' the diagfi.nc file: write down dimensions as well
!   as time-independent fields (e.g: geopotential, mesh area, ...)

!=======================================================================
!-----------------------------------------------------------------------
!   Declarations:
!   -------------

REAL pi
INTEGER nlat_eff
INTEGER jour0,mois0,an0
REAL timestep,t0
CHARACTER(len=20) :: calendrier

!   Arguments:
!   ----------


!$OMP MASTER
    IF (is_mpi_root) THEN       

! Bidouille pour gerer le fait que lat_reg contient deux latitudes
! en version uni-dimensionnelle (chose qui pourrait être résolue
! par ailleurs)
IF (klon_glo==1) THEN
   nlat_eff=1
ELSE
   nlat_eff=size(lat_reg)
ENDIF
pi=2.*asin(1.)

! PRINT*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref
! PRINT*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend

! Attention : les lignes ci dessous supposent un calendrier en 360 jours
! Pourrait être retravaillé

jour0=day_ref-30*(day_ref/30)
mois0=day_ref/30+1
an0=annee_ref
!FH BIZARE QUAND 1D ...  t0=(day_ini-1)*RDAY
t0=0.
calendrier=calend
IF ( calendrier == "earth_360d" ) calendrier="360_day"

PRINT*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0


CALL iotd_ini('phys.nc', &
size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier)
    ENDIF
!$OMP END MASTER

      END

#ifdef und
      SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
      IMPLICIT none

!=======================================================================
      INTEGER nfield,nlon,iim,jjmp1, jjm
      REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)

      INTEGER i, n, ig

      jjm = jjmp1 - 1
      DO n = 1, nfield
         DO i=1,iim
            ecrit(i,n) = fi(1,n)
            ecrit(i+jjm*iim,n) = fi(nlon,n)
         ENDDO
         DO ig = 1, nlon - 2
           ecrit(iim+ig,n) = fi(1+ig,n)
         ENDDO
      ENDDO
      RETURN
      END

#endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Interface pour ecrire en netcdf avec les routines d'enseignement
! iotd de Frederic Hourdin
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

      SUBROUTINE iotd_ecrit_seq(nom,lllm,titre,unite,px)

      IMPLICIT NONE

! px arrive 

      INCLUDE "iotd.h"


! Arguments on input:
      INTEGER lllm
      CHARACTER (LEN=*) :: nom,titre,unite
      INTEGER imjmax
      parameter (imjmax=100000)
      REAL px(imjmax*lllm)
      REAL, ALLOCATABLE :: zx(:,:,:)
      INTEGER i,j,l,ijl

      allocate(zx(imax,jmax,lllm))

      ijl=0
      do l=1,lllm
         ! Pole nord
         ijl=ijl+1
         do i=1,imax
            zx(i,1,l)=px(ijl)
         enddo
         ! Grille normale
         do j=2,jmax-1
            do i=1,imax
               ijl=ijl+1
               zx(i,j,l)=px(ijl)
            enddo
         enddo
         ! Pole sud
         IF ( jmax > 1 ) THEN
            ijl=ijl+1
            do i=1,imax
               zx(i,jmax,l)=px(ijl)
            enddo
         endif
      enddo

      CALL iotd_ecrit(nom,lllm,titre,unite,zx)
      deallocate(zx)

      RETURN
      END