Changeset 473 for trunk/NEMO/OPA_SRC/mppini_2.h90

Timestamp:

2006-05-11T17:04:37+02:00 (18 years ago)

Author:

opalod

Message:

nemo_v1_update_060: SM: IOM + 301 levels + CORE + begining of ctl_stop

File:

• trunk/NEMO/OPA_SRC/mppini_2.h90 (modified) (8 diffs)

trunk/NEMO/OPA_SRC/mppini_2.h90

@@ -40 +40 @@
       !!----------------------------------------------------------------------
       !! * Modules used
-      USE ioipsl
-
+      USE iom
+   
       !! Local variables
-      CHARACTER (len=25) ::               &  ! temporary name
-                clname , clvar               ! filename and cdf variable name for bathy
-      LOGICAL ::   llbon                      ! check the existence of bathy files
       INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::   inum = 11                  ! temporary logical unit
+      INTEGER ::  inum                        ! temporary logical unit
       INTEGER ::   &
          ii, ij, ifreq, il1, il2,          &  ! temporary integers
@@ -66 +63 @@
          ione  , ionw  , iose  , iosw  ,   &  !    "           "
          ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER  ::   &
-         ipi, ipj, ipk,              &  ! temporary integers
-         itime                          !    "          "
-      INTEGER, DIMENSION (1) ::   istep
-
-      INTEGER, DIMENSION(jpiglo,jpjglo) ::   &
+      INTEGER, DIMENSION(jpi,jpj) ::   &
          imask                                ! temporary global workspace
-
-      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
-         zlamt, zphit, zdta                   ! temporary data workspace
-      REAL(wp), DIMENSION(jpk) ::   &   
-         zdept                                ! temporary workspace (NetCDF read)
-      REAL(wp) ::   zidom , zjdom,   &        ! temporary scalars
-         zdt, zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zdta                   ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
 
       !!----------------------------------------------------------------------
@@ -103 +91 @@
 #endif
 
-
-      IF( jpni*jpnj < jpnij ) THEN
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible'
-         nstop = nstop + 1
-      ENDIF
-
+      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
 
       ! 0. initialisation
@@ -115 +97 @@
 
       ! open the file
-         IF ( ln_zco ) THEN 
-            clname = 'bathy_level.nc'         ! Level bathymetry
-            clvar = 'Bathy_level'
-         ELSE
-            clname = 'bathy_meter.nc'         ! Meter bathy in case of partial steps
-            clvar = 'Bathymetry'
-         ENDIF
-#if defined key_agrif
-      if ( .NOT. Agrif_Root() ) then
-         clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
-      endif
-#endif         
-
-         INQUIRE( FILE=clname, EXIST=llbon )
-      IF( llbon ) THEN
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) '         read bathymetry in ', clname
-            IF(lwp) WRITE(numout,*)
-            itime = 1
-            ipi = jpidta
-            ipj = jpjdta
-            ipk = 1
-            zdt = rdt
-
-            CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   &
-                           ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum )
-            CALL flinget( inum, clvar, jpidta, jpjdta, 1,   &
-                          itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )
-            CALL flinclo( inum )
+      IF ( ln_zco ) THEN 
+         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
+         CALL iom_get ( inum, jpdom_data, 'Bathy_level', zdta )
       ELSE
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*)'    mppini_2 : unable to read the file ', clname
-         nstop = nstop + 1
-      ENDIF
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         CALL iom_get ( inum, jpdom_data, 'Bathymetry' , zdta )
+      ENDIF
+      CALL iom_close (inum)
 
       ! land/sea mask over the global/zoom domain
 
-      imask(:,:) = 1
-      WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0
+      imask(:,:)=1
+      WHERE ( zdta(:,:) <= 0. ) imask = 0
 
       !  1. Dimension arrays for subdomains
@@ -328 +284 @@
          DO jj = 1+jprecj, ilj-jprecj
             DO  ji = 1+jpreci, ili-jpreci
-               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+               IF( imask(ji, jj) == 1) isurf = isurf+1
             END DO
          END DO
@@ -341 +297 @@
       ! Control
       IF(icont+1 /= jpnij) THEN
-         IF(lwp) THEN 
-            WRITE(numout,*) ' Eliminate land processors algorithm'
-            WRITE(numout,*)
-            WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
-            WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-            WRITE(numout,*)
-            WRITE(numout,*) ' E R R O R '
-            WRITE(numout,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-            WRITE(numout,*) ' we stop'
-         ENDIF
-         STOP 'mpp_init2'
-      ENDIF
-
+         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
+         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
+      ENDIF
 
       ! 4. Subdomain print
@@ -518 +466 @@
       ! Save processor layout in ascii file
       IF (lwp) THEN
-        OPEN(inum,FILE='layout.dat')
-        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+         inum = 11 ! how do we know that 11 is ok???
+         OPEN(inum,FILE='layout.dat')
+         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
 
         DO  jproc = 1, jpnij
@@ -565 +514 @@
       ENDIF
 
-      IF( nperio == 1 .AND.jpni /= 1 ) THEN
-         IF(lwp) WRITE(numout,cform_err)
-         IF(lwp) WRITE(numout,*) ' mpp_init2:  error on cyclicity'
-         nstop = nstop + 1
-      ENDIF
+      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
 
       ! Prepare mpp north fold