MODULE mo_sst
      
        IMPLICIT NONE
      
   5:   REAL, ALLOCATABLE :: sst(:,:,:)  ! (nlon,ngl,0:13) in global coordinates
      
      CONTAINS
      
        SUBROUTINE readsst
  10: 
          ! U. Schlese, DKRZ,  May 1993, original version
          ! U. Schulzweida, MPI, May 1999, netCDF version
      
          USE mo_start_dataset, ONLY: nist, nstep
  15:     USE mo_doctor,        ONLY: nout
          USE mo_control,       ONLY: ncbase, ntbase, dtime, lamip
          USE mo_exception,     ONLY: finish
          USE mo_io
          USE mo_mpi,           ONLY: p_pe, p_io   
  20:     USE mo_decomposition, ONLY: lc => local_decomposition, global_decomposition
          USE mo_transpose,     ONLY: scatter_gp
          USE mo_year,          ONLY: cd2dat
          
          REAL, ALLOCATABLE, TARGET :: zin(:,:,:)
  25:     REAL, POINTER :: gl_sst(:,:,:)
      
          CHARACTER (7) :: fn0, fn1, fn2
          INTEGER       :: i, iday, id, im, iy
          INTEGER       :: ihy0, ihy1, ihy2
  30:     LOGICAL       :: lex, lex0, lex1, lex2
          INTEGER       :: start(3), count(3), nvarid
      
          iday = ncbase+(ntbase+dtime*(nstep+1))/86400.+0.01
          CALL cd2dat (iday, id, im, iy)
  35: 
          ihy0 = iy - 1
          ihy1 = iy
          ihy2 = iy + 1
      
  40:     IF (iy < 100) THEN
             WRITE (fn0, '("sst",i2.2)') ihy0
             WRITE (fn1, '("sst",i2.2)') ihy1
             IF(iy/= 99) THEN
                WRITE (fn2, '("sst",i2.2)') ihy2
  45:        ELSE
                WRITE (fn2, '("sst",i3)') ihy2
             ENDIF
          ELSE IF (iy< 1000) THEN
             IF (iy/= 100) THEN
  50:           WRITE (fn0, '("sst",i3)') ihy0
             ELSE
                WRITE (fn0, '("sst",i2.2)') ihy0
             ENDIF
             WRITE (fn1, '("sst",i3)') ihy1
  55:        IF(iy/= 999) THEN
                WRITE (fn2, '("sst",i3)') ihy2
             ELSE
                WRITE (fn2, '("sst",i4)') ihy2
             ENDIF
  60:     ELSE
             IF(iy/= 1000) THEN
                WRITE (fn0, '("sst",i4)') ihy0
             ELSE
                WRITE (fn0, '("sst",i3)') ihy0
  65:        ENDIF
             WRITE (fn1, '("sst",i4)') ihy1
             WRITE (fn2, '("sst",i4)') ihy2
          ENDIF
      
  70:     WRITE (nout, '(/)')
      
          ! Amip-type:
      
          IF(lamip) THEN
  75:        IF (p_pe == p_io) THEN
                WRITE (nout,*)  'This is an AMIP run (lamip = .true.).'
             END IF   
             INQUIRE (file=fn0, exist=lex0)
             INQUIRE (file=fn1, exist=lex1)
  80:        INQUIRE (file=fn2, exist=lex2)
             IF (lex1) THEN
                CALL IO_open (fn1, sstnc1, IO_READ)
                WRITE (nout,*) 'Reading sst from files ',fn0, ', ',fn1,', ',fn2
                IF(lex0) THEN
  85:              CALL IO_open (fn0, sstnc0, IO_READ)
                ELSE
                   WRITE (nout,*) 'Could not open file <',fn0,'>'
                   CALL finish ('readsst', 'run terminated.')
                ENDIF
  90:           IF(lex2) THEN
                   CALL IO_open (fn2, sstnc2, IO_READ)
                ELSE
                   WRITE (nout,*) 'Could not open file <',fn2,'>'
                   CALL finish ('readsst', 'run terminated.')
  95:           ENDIF
             ELSE
                WRITE (nout,*) 'Could not open file <',fn1,'>'
                CALL finish ('readsst', 'run terminated.')
             ENDIF
 100:     ELSE
             IF (p_pe == p_io) THEN
                WRITE (nout,*)  'This is no AMIP run (lamip = .false.).'
             END IF   
             INQUIRE (nist, exist=lex)
 105:        IF (lex) THEN
                CALL IO_open_unit (nist, sstnc1, IO_READ)
             ELSE
                WRITE (nout,*) 'Could not open sst file'
                CALL finish ('readsst', 'run terminated.')
 110:        ENDIF
          ENDIF
      
          !     Allocate memory for sst per PE
      
 115:     ALLOCATE (sst(lc%nglon,lc%nglat,0:13))
      
          !     Read sst-file
          IF (p_pe == p_io) THEN
      
 120:        !     Allocate memory for sst global fields
             
             ALLOCATE (zin(lc%nlon,lc%nlat,0:13))
      
             CALL IO_INQ_VARID (sstnc1%nc_file_id, 'sst', nvarid)
 125:        CALL IO_GET_VAR_DOUBLE (sstnc1%nc_file_id, nvarid, zin(:,:,1:12))
      
             IF(.NOT.lamip) THEN
                zin(:,:,0)  = zin(:,:,12)
                zin(:,:,13) = zin(:,:,1)
 130:        ELSE 
                CALL IO_INQ_VARID (sstnc0%nc_file_id, 'sst', nvarid)
                count(:) = (/ lc%nlon, lc%nlat, 1 /)
                start(:) = (/ 1, 1, 12 /)
                CALL IO_GET_VARA_DOUBLE (sstnc0%nc_file_id,nvarid,start,count,zin(1,1,0))
 135: 
                CALL IO_INQ_VARID (sstnc2%nc_file_id, 'sst', nvarid)
                count(:) = (/ lc%nlon, lc%nlat, 1 /)
                start(:) = (/ 1, 1, 1 /)
                CALL IO_GET_VARA_DOUBLE (sstnc2%nc_file_id,nvarid,start,count,zin(1,1,13))
 140:        END IF
          END IF
      
          NULLIFY (gl_sst)
          DO i = 0, 13
 145:        IF (p_pe == p_io) gl_sst => zin(:,:,i:i)
             CALL scatter_gp (gl_sst, sst(:,:,i:i), global_decomposition)
          END DO   
      
          IF (p_pe == p_io) THEN
 150:        DEALLOCATE (zin)
          END IF
      
          !    Close file(s)
      
 155:     CALL IO_close(sstnc1)
      
          IF(lamip) THEN
             CALL IO_close(sstnc0)
             CALL IO_close(sstnc2)
 160:     ENDIF
      
        END SUBROUTINE readsst
      
      END MODULE mo_sst


Info Section
         uses:  mo_control, mo_decomposition, mo_doctor, mo_exception, mo_io 
                mo_mpi, mo_start_dataset, mo_transpose, mo_year 
        calls:  cd2dat, finish, io_close, io_get_var_double, io_get_vara_double 
                io_inq_varid, io_open, io_open_unit, scatter_gp 

HTML derived from FORTRAN source by f2html.pl v0.3 (C) 1997,98 Beroud Jean-Marc.