ncpost.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ######spl
        PROGRAM ncpost
!
!!    MODIFICATIONS
!!    -------------
!!      B. Decharme : partition pgd/prep (grid attributes are only in the PGD file)
!!
!-------------------------------------------------------------------------------
!
USE modd_off_surfex_n
!
        USE modd_io_surf_asc
        USE modd_surf_par
        USE modi_open_filein_ol
        USE modi_close_filein_ol
        USE modi_read_surf
        USE mode_pos_surf
!
        USE yomhook   ,ONLY : lhook,   dr_hook
        USE parkind1  ,ONLY : jprb
!
        USE modi_end_io_surf_n
        USE modi_init_io_surf_n
        IMPLICIT NONE        

        REAL, ALLOCATABLE, DIMENSION(:)   ::   zloc
        REAL, ALLOCATABLE, DIMENSION(:)   ::   zwrk
        REAL, ALLOCATABLE, DIMENSION(:)   ::   xlon
        REAL, ALLOCATABLE, DIMENSION(:)   ::   xlat
        INTEGER, ALLOCATABLE, DIMENSION(:)::   iwrk2
        CHARACTER(LEN=50)                 ::   ycomment
        CHARACTER(LEN=50)                 ::   nom_article
        CHARACTER(LEN=12)                 ::   hrec
        CHARACTER(LEN=1)                  ::   patchflag
        CHARACTER(LEN=2)                  ::   ypas,ylvl
        CHARACTER(LEN=10)                 ::   cgrid_type
        LOGICAL                           ::   gfound
        LOGICAL                           ::   linits ! true if PGD has been run
        LOGICAL                           ::   lsxnam ! true if NCPOST.nam present
        LOGICAL                           ::   lcoord ! true if LONLAT.dat present
        LOGICAL                           ::   lgeo=.true.  !

        INTEGER    ::   iret
        INTEGER    ::   ini
        INTEGER    ::   inj
        INTEGER    ::   if, ic, ip
        INTEGER    ::   ifield, iwfield
        INTEGER    ::   ipatch, jpatch
        INTEGER    ::   ibeg, iend

        

        !plm
        !=====================================================================
        real, allocatable, dimension(:,:,:)   ::   zfield3d
        real, allocatable, dimension(:,:)     ::   zfield2d
        character (len=40) :: cfile
        character (len=56) :: comlink
        integer    ::   inb_forc
        integer    ::   ji
        REAL(KIND=JPRB) :: zhook_handle
        !=====================================================================

        IF (lhook) CALL dr_hook('NCPOST',0,zhook_handle)
        CALL surfex_alloc_list(1)  
       CALL goto_model(1)

        !=====================================================================
        !*
        !** get domain size and read latitudes and longitudes 
        !*
        !=====================================================================

        INQUIRE(file='LONLAT.dat',exist=lcoord)
        IF (.NOT.lcoord) THEN

           INQUIRE(file='PGD.txt', exist=linits)
      
           IF (.NOT. linits) THEN
              WRITE(*,*)' Now grid attributes are only in the PGD file'
              WRITE(*,*)' NO INPUT FILE FOUND FOR NCPOST'
              WRITE(*,*)' YOU SHOULD AT LEAST RUN PGD! '
              stop
           ELSE
              cfilein='PGD.txt'
           ENDIF

 CALL init_io_surf_n(ysurf_cur%DTCO, ysurf_cur%DGU, ysurf_cur%U, &
                        'ASCII ','FULL  ','SURF  ','READ ')

           CALL read_surf(&
                          'ASCII ','DIM_FULL', ini, iret)
           CALL read_surf(&
                          'ASCII ','GRID_TYPE', cgrid_type, iret)

        
           ALLOCATE(xlon(ini))
           ALLOCATE(xlat(ini))

           IF (cgrid_type=='GAUSS     ') THEN
              CALL posnam(nunit,'FULL  '//' '//'LONGAUSS',gfound,nluout)
           ELSE
              CALL posnam(nunit,'FULL  '//' '//'XLON',gfound,nluout)
           ENDIF

           READ(nunit,fmt=*)
           READ(nunit,fmt='(A50)') ycomment
           READ(nunit,fmt=*,err=100) xlon(:)

           IF (cgrid_type=='GAUSS     ') THEN
              CALL posnam(nunit,'FULL  '//' '//'LATGAUSS',gfound,nluout)
           ELSE
              CALL posnam(nunit,'FULL  '//' '//'XLAT',gfound,nluout)
           ENDIF

           READ(nunit,fmt=*)
           READ(nunit,fmt='(A50)') ycomment
           READ(nunit,fmt=*,err=100) xlat(:)

           OPEN(unit=30,file='LONLAT.dat',form='FORMATTED')
           DO ip=1,ini
              WRITE(30,*)xlon(ip),xlat(ip)
           ENDDO

           CALL end_io_surf_n('ASCII ')
                   
        ENDIF

        !=====================================================================
        !*
        !** read fields from netcdf output file
        !*
        !=====================================================================

        INQUIRE(file='NCPOST.nam',exist=lsxnam)
        IF (.NOT.lsxnam) THEN
           WRITE(*,*)' > NCPOST.nam does not exist'
           stop
        ENDIF
        OPEN(unit=46,file='NCPOST.nam',form='FORMATTED')
        READ(46,'(A1,1X,A6,1X,A16,1X,A40)')patchflag,cmask,hrec,cfile

        CALL open_filein_ol
 CALL init_io_surf_n(ysurf_cur%DTCO, ysurf_cur%DGU, ysurf_cur%U, &
                        'OFFLIN','FULL  ','SURF  ','READ ')
        
        CALL read_surf(&
                       'OFFLIN','DIM_FULL', ini, iret)
        ALLOCATE(xlon(ini))
        ALLOCATE(xlat(ini))
        OPEN(unit=30,file='LONLAT.dat',form='FORMATTED')
        DO ip=1,ini
           READ(30,*)xlon(ip),xlat(ip)
        ENDDO

        CALL read_surf(&
                       'OFFLIN','NB_TIMESTP', inb_forc, iret)
        CALL read_surf(&
                          'OFFLIN','PATCH_NUMBER', ipatch, iret)
        CALL system('rm SXPOST.nc')
        comlink='ln -s '//cfile//' SXPOST.nc'
        CALL system(comlink)

        IF (cmask == 'FORC') THEN
           allocate(zfield2d(inb_forc-1,ini))
           CALL read_surf(&
                          'OFFLIN',hrec,zfield2d(:,:), iret)
           do ji=1,ini
              write(50,*)xlon(ji),xlat(ji),zfield2d(1,ji)
           enddo
        ELSEIF (cmask == 'SIMU') THEN
           IF (patchflag == '+') THEN
              allocate(zfield3d(ini,ipatch,inb_forc-1))
              CALL read_surf(&
                             'OFFLIN',hrec,zfield3d(:,:,:), iret)
              do ji=1,ini
                 write(50,*)xlon(ji),xlat(ji),zfield3d(ji,1,1)
              enddo
           ELSE IF (patchflag == '-') THEN
              allocate(zfield2d(ini,inb_forc-1))
              CALL read_surf(&
                             'OFFLIN',hrec,zfield2d(:,:), iret)
              do ji=1,ini
                 write(50,*)xlon(ji),xlat(ji),zfield2d(ji,1)
              enddo
           ENDIF
        ELSE
           write(*,*)' > ',cmask,'NOT ALLOWED (only FORC|SIMU)'
           write(*,*)' > Update NCPOST.nam'
           stop
        ENDIF

        CALL close_filein_ol
        CALL surfex_deallo_list

        stop
 100    CONTINUE
        WRITE(nluout,*) ' '
        WRITE(nluout,*) ' ERROR WHEN READING ARTICLE',hrec
        WRITE(nluout,*) ' '
        

        IF (lhook) CALL dr_hook('NCPOST',1,zhook_handle)
        CONTAINS

        SUBROUTINE err_stop(HREC,CFILEIN,NLUOUT)
        CHARACTER(LEN=12)   ::   hrec
        CHARACTER(LEN=*)    ::   cfilein
        INTEGER             ::   nluout
        REAL(KIND=JPRB) :: zhook_handle
        IF (lhook) CALL dr_hook('ERR_STOP',0,zhook_handle)
        WRITE(nluout,*) ' '
        WRITE(nluout,*) ' ARTICLE ',trim(hrec),' NOT FOUND IN FILE ', cfilein
        WRITE(nluout,*) ' '
        WRITE(*,*) ' '
        WRITE(*,*) ' ARTICLE ',trim(hrec),' NOT FOUND IN FILE ', cfilein
        WRITE(*,*) ' '
        stop
        IF (lhook) CALL dr_hook('ERR_STOP',1,zhook_handle)
        END SUBROUTINE err_stop

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


        END PROGRAM ncpost