New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12933 for NEMO/trunk/src/OCE/LBC – NEMO

Ignore:
Timestamp:
2020-05-15T10:06:25+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge back r12581_ticket2418 branch into the trunk, see #2418

Location:
NEMO/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12798        sette 
         10^/utils/CI/sette@12931        sette 

  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r12512 r12933  
    11121112      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5 
    11131113      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10 
     1114      ! 
     1115      CHARACTER(LEN=8) ::   clfmt            ! writing format 
     1116      INTEGER ::   inum 
     1117      INTEGER ::   idg  ! number of digits 
    11141118      !!---------------------------------------------------------------------- 
    11151119      ! 
    11161120      nstop = nstop + 1 
    11171121      ! 
    1118       ! force to open ocean.output file if not already opened 
    1119       IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1122      IF( numout == 6 ) THEN                          ! force to open ocean.output file if not already opened 
     1123         CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1124      ELSE 
     1125         IF( narea > 1 .AND. cd1 == 'STOP' ) THEN     ! add an error message in ocean.output 
     1126            CALL ctl_opn( inum,'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     1127            WRITE(inum,*) 
     1128            idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     1129            WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg     ! '(a,ix.x)' 
     1130            WRITE(inum,clfmt) ' ===>>> : see E R R O R in ocean.output_', narea - 1 
     1131         ENDIF 
     1132      ENDIF 
    11201133      ! 
    11211134                            WRITE(numout,*) 
    … …  
    11451158         WRITE(numout,*)  'huge E-R-R-O-R : immediate stop' 
    11461159         WRITE(numout,*)   
     1160         CALL FLUSH(numout) 
     1161         CALL SLEEP(60)   ! make sure that all output and abort files are written by all cores. 60s should be enough... 
    11471162         CALL mppstop( ld_abort = .true. ) 
    11481163      ENDIF 
    … …  
    12071222      ! 
    12081223      CHARACTER(len=80) ::   clfile 
     1224      CHARACTER(LEN=10) ::   clfmt            ! writing format 
    12091225      INTEGER           ::   iost 
     1226      INTEGER           ::   idg  ! number of digits 
    12101227      !!---------------------------------------------------------------------- 
    12111228      ! 
    … …  
    12141231      clfile = TRIM(cdfile) 
    12151232      IF( PRESENT( karea ) ) THEN 
    1216          IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 
     1233         IF( karea > 1 ) THEN 
     1234            idg = MAX( INT(LOG10(REAL(jpnij-1,wp))) + 1, 4 )        ! how many digits to we need to write? min=4, max=9 
     1235            WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg   ! '(a,a,ix.x)' 
     1236            WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 
     1237         ENDIF 
    12171238      ENDIF 
    12181239#if defined key_agrif 

  • NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90

    r10716 r12933  
    3232      REAL(wp)        , INTENT(  out) ::   pmin    ! Global minimum of ptab 
    3333      INDEX_TYPE(:)                                ! index of minimum in global frame 
    34 # if defined key_mpp_mpi 
    3534      ! 
    3635      INTEGER  ::   ierror, ii, idim 
    … …  
    5655         ! 
    5756         kindex(1) = mig( ilocs(1) ) 
    58 #  if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
     57#if defined DIM_2d || defined DIM_3d    /* avoid warning when kindex has 1 element */ 
    5958         kindex(2) = mjg( ilocs(2) ) 
    60 #  endif 
    61 #  if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
     59#endif 
     60#if defined DIM_3d                      /* avoid warning when kindex has 2 elements */ 
    6261         kindex(3) = ilocs(3) 
    63 #  endif 
     62#endif 
    6463         !  
    6564         DEALLOCATE (ilocs) 
    6665         ! 
    6766         index0 = kindex(1)-1   ! 1d index starting at 0 
    68 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     67#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    6968         index0 = index0 + jpiglo * (kindex(2)-1) 
    70 #  endif 
    71 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     69#endif 
     70#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    7271         index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 
    73 #  endif 
     72#endif 
    7473      END IF 
    7574      zain(1,:) = zmin 
    … …  
    7776      ! 
    7877      IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
     78#if defined key_mpp_mpi 
    7979      CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 
     80#else 
     81      zaout(:,:) = zain(:,:) 
     82#endif 
    8083      IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    8184      ! 
    8285      pmin      = zaout(1,1) 
    8386      index0    = NINT( zaout(2,1) ) 
    84 #  if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
     87#if defined DIM_3d                     /* avoid warning when kindex has 2 elements */ 
    8588      kindex(3) = index0 / (jpiglo*jpjglo) 
    8689      index0    = index0 - kindex(3) * (jpiglo*jpjglo) 
    87 #  endif 
    88 #  if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
     90#endif 
     91#if defined DIM_2d || defined DIM_3d   /* avoid warning when kindex has 1 element */ 
    8992      kindex(2) = index0 / jpiglo 
    9093      index0 = index0 - kindex(2) * jpiglo 
    91 #  endif 
     94#endif 
    9295      kindex(1) = index0 
    9396      kindex(:) = kindex(:) + 1   ! start indices at 1 
    94 #else 
    95       kindex = 0 ; pmin = 0. 
    96       WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?' 
    97 #endif 
    9897 
    9998   END SUBROUTINE ROUTINE_LOC 
Note: See TracChangeset for help on using the changeset viewer.