source: trunk/src/SIMULS_IRCAAM/progfiltrage_simulation.f @ 55

      PROGRAM progfiltrage_simulation
C+
C
C NAME
C ====
C
C ``progfiltrage_simulation.x``
C
C SYNOPSIS
C ========
C
C ``progfiltrage_simulation.x``
C
C DESCRIPTION
C ===========
C
C filtrage sur olr JAN-DEC de 1968
C ++
C
C From olr_nofiltre_arpege_ \ *simulation*\ .dat.
C ``progfiltrage_simulation.x`` compute ++.
C
C ``progfiltrage_simulation.x`` write
C olr_filtre_\ *period1*\ -\ *period2*\ d_arpege_ \ *simulation*\ .dat.
C
C
C CAUTIONS
C ========
C
C On MAC ppc, this program must be compile with ``-fendian=little``
C for g95
C according to machineformat used in prepare_olr_filtre_simulation.m_.
C
C EXAMPLES
C ========
C
C Following line read ``olr_nofiltre_arpege_AfNQIVIV.dat``,
C compute ++,
C write ``olr_filtre_10-30d_arpege_AfNQIVIV.dat``
C ::
C
C $ echo "arpege AfNQIVIV 10 30" | progfiltrage_simulation.x -
C
C SEE ALSO
C ========
C
C prepare_olr_filtre_simulation.m_
C
C .. _prepare_olr_filtre_simulation.m : prepare_olr_filtre_simulation.m.html
C
C forfilter.f_
C
C .. _forfilter.f : forfilter.f.html
C
C TODO
C ====
C
C underflow tracking (see ifort failure)
C
C REAL ou DOUBLE PRECISION dans les fichiers matlab
C
C improve description
C
C improve file pb (err in open/read/write)
C
C F90 modules
C
C portability check because of getenv : now (20090203) written for
C working on zeus using g95 (GCC 4.0.3 (g95!) Jun 18 2006)
C
C use PT fortran tool box ?! when public ...
C
C direct access file ? seems to work but see also
C http://objectmix.com/fortran/305264-read-binaries-matlab.html
C
C EVOLUTIONS
C ==========
C
C $Id$
C
C - fplod 2009-02-10T13:57:29Z aedon.locean-ipsl.upmc.fr (Darwin)
C
C   * bug fix on output file name to be compatible to convention
C     (not fixed period number of digits)
C
C - fplod 2009-02-02T13:45:57Z aedon.locean-ipsl.upmc.fr (Darwin)
C
C   * created from progfiltrage_10_30.f  to replace it as well as
C     progfiltrage_30_100.f
C
C   * Subroutines externalized in forfilter.f
C
C   * add parameters ircaam_dataset and simulation according to
C     prepare_olr_filtre_simulation.m
C
C   * consolidation : implicit none, inquire iolength, force
C     LITTLE ENDIAN
C
C-
C
      IMPLICIT NONE

      EXTERNAL FILTRE

      INTEGER, PARAMETER :: nb = 3660
      INTEGER :: period1
      INTEGER :: period2
C
      INTEGER :: i
      INTEGER :: j
      INTEGER :: k
      INTEGER :: l
      INTEGER :: lon0
      INTEGER :: lat0
C
      REAL :: olr(24,15,nb),vb(nb)
      REAL :: vvb(nb),vvvb(nb),olrf(24,15,nb)
C
      CHARACTER (LEN=255) :: ircaam_id
      CHARACTER (LEN=255) :: ircaam_od
C
      CHARACTER (LEN=255) :: fullfilename
      CHARACTER (LEN=255) :: fullfilename_format
      INTEGER :: record_length = 0
C
      CHARACTER (LEN=6) :: ircaam_dataset
      CHARACTER (LEN=8) :: simulation
      LOGICAL           :: vsel = .TRUE.

      write (*,*) 'enter ircaam_dataset simulation period1 period2'
      read (*,*) ircaam_dataset,simulation,period1,period2

      write (*,*) 'ircaam_dataset : ', ircaam_dataset
      write (*,*) 'simulation : ', simulation
      write (*,*) 'period1 : ', period1
      write (*,*) 'period2 : ', period2

C validation of ircaam_dataset
      IF (ircaam_dataset /= 'arpege') THEN
       vsel = .FALSE.
       WRITE(*,*)' eee : pb validation ircaam_dataset'
      ENDIF

C validation of simulation
      IF ((simulation /= 'AfNQIVIV') .AND.
     +    (simulation /= 'TrNQIVIV') .AND.
     +    (simulation /= 'AsNQIVIV') .AND.
     +    (simulation /= 'CtIV') .AND.
     +    (simulation /= 'CtCl ')) THEN
       vsel = .FALSE.
       WRITE(*,*)' eee : pb validation simulation'
      ENDIF

C validation of period1 and period2

      IF (period1 >= period2) THEN
       vsel = .FALSE.
       WRITE(*,*)' eee : pb validation period1 vs period2'
      ENDIF
C
      IF (.NOT. vsel) THEN
       GOTO 994
      ENDIF

      CALL GETENV('IRCAAM_ID',ircaam_id)
C++      ircaam_id='/usr/temp/fplod/ircaam_d/'
      CALL GETENV('IRCAAM_OD',ircaam_od)
C++      ircaam_od='/usr/temp/fplod/ircaam_d/'

      WRITE(fullfilename,'(A,A,A,A,A,A)')
     +TRIM(ircaam_id),
     +'olr_nofiltre_',
     +TRIM(ircaam_dataset),
     +'_',
     +TRIM(simulation),
     +'.dat'

C ask for record length
      INQUIRE (IOLENGTH=record_length)
     +(((olr(i,j,k),i=1,24),j=1,15),k=1,nb)

      open(1,file=fullfilename
     +,status='old'
     +,form='unformatted',access='direct',recl=record_length)

      read(1,rec=1)
     +(((olr(i,j,k),i=1,24),j=1,15),k=1,nb)

      CLOSE(1)

c  l'ordre maximal du filtrage est tel que 2*MOR+1 < nb
c  veuillez changer dans la subroutine FILTRE le parameter MOR

      do lon0=1,24
       do lat0=1,15
        do i=1,nb
         vb(i)=olr(lon0,lat0,i)
        enddo
        call filtre(vb,vvb,REAL(period1),nb)
        call filtre(vb,vvvb,REAL(period2),nb)
        do i=1,nb
         olrf(lon0,lat0,i)=vvb(i)-vvvb(i)
        enddo
       enddo
      enddo
C      print*,(olrf(1,1,j),j=1,nb)

C adjust format of output filename according to period1 and period2 values
      fullfilename_format = '(A,A,'
      IF (period1 < 10 ) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I1,'
      ENDIF
      IF ((period1 >= 10) .AND. (period1 < 100)) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I2,'
      ENDIF
      IF (period1 >= 100 ) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I3,'
      ENDIF
      fullfilename_format = TRIM(fullfilename_format) //'A,'
      IF (period2 < 10 ) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I1,'
      ENDIF
      IF ((period2 >= 10) .AND. (period2 < 100)) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I2,'
      ENDIF
      IF (period2 >= 100 ) THEN 
       fullfilename_format = TRIM(fullfilename_format)//'I3,'
      ENDIF

      fullfilename_format = TRIM(fullfilename_format)//'A,A,A,A,A)'

      WRITE(fullfilename,fullfilename_format)
     +TRIM(ircaam_od),
     +'olr_filtre_',
     +period1,
     +'-',
     +period2,
     +'d_',
     +TRIM(ircaam_dataset),
     +'_',
     +TRIM(simulation),
     +'.dat'

      open(2,file=fullfilename
     +,status='replace'
     +,form='unformatted',access='direct',recl=24*15*nb*4)

      write(2,rec=1)(((olrf(lon0,lat0,l),lon0=1,24),
     +                lat0=1,15),l=1,nb)
      close(2)

994   CONTINUE
      STOP
      END