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

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 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
  USE lmdz_iotd, ONLY: iotd_ecrit

  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
  USE lmdz_iotd, ONLY: iotd_ini
  USE lmdz_yomcst

  IMPLICIT NONE

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

  !   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)
  USE lmdz_iotd, ONLY: iotd_ecrit, imax, jmax

  IMPLICIT NONE

  ! 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