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 11564 for NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/SAS/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2019-09-18T16:11:52+02:00 (5 years ago)
Author:
jchanut
Message:

#2199, merged with trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/SAS/nemogcm.F90

    r10601 r11564  
    151151      ! 
    152152      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    153          WRITE(numout,cform_err) 
    154          WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    155          WRITE(numout,*) 
     153         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
     154         CALL ctl_stop( ctmp1 ) 
    156155      ENDIF 
    157156      ! 
     
    169168#endif 
    170169      ! 
     170      IF(lwm) THEN 
     171         IF( nstop == 0 ) THEN   ;   STOP 0 
     172         ELSE                    ;   STOP 123 
     173         ENDIF 
     174      ENDIF 
     175      ! 
    171176   END SUBROUTINE nemo_gcm 
    172177 
     
    178183      !! ** Purpose :   initialization of the NEMO GCM 
    179184      !!---------------------------------------------------------------------- 
    180       INTEGER  ::   ji                 ! dummy loop indices 
    181       INTEGER  ::   ios, ilocal_comm   ! local integers 
    182       CHARACTER(len=120), DIMENSION(30) ::   cltxt, cltxt2, clnam 
    183       CHARACTER(len=80)                 ::   clname 
     185      INTEGER ::   ios, ilocal_comm   ! local integers 
    184186      !! 
    185187      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    189191      !!---------------------------------------------------------------------- 
    190192      ! 
    191       cltxt  = '' 
    192       cltxt2 = '' 
    193       clnam  = ''   
    194       cxios_context = 'nemo' 
    195       ! 
    196       !                             ! Open reference namelist and configuration namelist files 
    197       IF( lk_oasis ) THEN  
    198          CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    199          CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    200          cxios_context = 'sas' 
    201          clname = 'output.namelist_sas.dyn' 
    202       ELSE 
    203          CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    204          CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    205          cxios_context = 'nemo' 
    206          clname = 'output.namelist.dyn' 
    207    ENDIF 
    208       ! 
    209       REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    210       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    211 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    212       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    213       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    214 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    215       ! 
    216       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    217       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    218 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    219       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    220       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    221 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    222  
    223       !                             !--------------------------! 
    224       !                             !  Set global domain size  !   (control print return in cltxt2) 
    225       !                             !--------------------------! 
    226       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    227          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    228          ! 
    229       ELSE                                ! user-defined namelist 
    230          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    231       ENDIF 
    232       ! 
    233       ! 
    234       !                             !--------------------------------------------! 
    235       !                             !  set communicator & select the local node  ! 
    236       !                             !  NB: mynode also opens output.namelist.dyn ! 
    237       !                             !      on unit number numond on first proc   ! 
    238       !                             !--------------------------------------------! 
     193      IF( lk_oasis ) THEN   ;   cxios_context = 'sas' 
     194      ELSE                  ;   cxios_context = 'nemo' 
     195      ENDIF 
     196      ! 
     197      !                             !-------------------------------------------------! 
     198      !                             !     set communicator & select the local rank    ! 
     199      !                             !  must be done as soon as possible to get narea  ! 
     200      !                             !-------------------------------------------------! 
     201      ! 
    239202#if defined key_iomput 
    240203      IF( Agrif_Root() ) THEN 
    241204         IF( lk_oasis ) THEN 
    242             CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis  
    243             CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
     205            CALL cpl_init( "sas", ilocal_comm )                                  ! nemo local communicator given by oasis  
     206            CALL xios_initialize( "not used",local_comm=ilocal_comm )            ! send nemo communicator to xios 
    244207         ELSE 
    245208            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
    246209         ENDIF 
    247210      ENDIF 
    248       narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection 
     211      CALL mpp_start( ilocal_comm ) 
    249212#else 
    250213      IF( lk_oasis ) THEN 
    251214         IF( Agrif_Root() ) THEN 
    252             CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis 
     215            CALL cpl_init( "sas", ilocal_comm )             ! nemo local communicator given by oasis 
    253216         ENDIF 
    254          narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt) 
     217         CALL mpp_start( ilocal_comm ) 
    255218      ELSE 
    256          ilocal_comm = 0 
    257          narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt) 
    258       ENDIF 
    259 #endif 
    260  
    261       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    262  
    263       IF( sn_cfctl%l_config ) THEN 
    264          ! Activate finer control of report outputs 
    265          ! optionally switch off output from selected areas (note this only 
    266          ! applies to output which does not involve global communications) 
    267          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    268            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    269            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     219         CALL mpp_start( ) 
     220      ENDIF 
     221#endif 
     222      ! 
     223      narea = mpprank + 1                                   ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     224      lwm = (narea == 1)                ! control of output namelists 
     225      ! 
     226      !                             !---------------------------------------------------------------! 
     227      !                             ! Open output files, reference and configuration namelist files ! 
     228      !                             !---------------------------------------------------------------! 
     229      ! 
     230      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     231      IF( lk_oasis ) THEN 
     232         IF( lwm )   CALL ctl_opn(     numout,              'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     233         ! open reference and configuration namelist files 
     234                     CALL ctl_opn( numnam_ref,        'namelist_sas_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     235                     CALL ctl_opn( numnam_cfg,        'namelist_sas_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     236         IF( lwm )   CALL ctl_opn(     numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    270237      ELSE 
    271          ! Use ln_ctl to turn on or off all options. 
    272          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    273       ENDIF 
    274  
    275       lwm = (narea == 1)                                    ! control of output namelists 
    276       lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    277  
    278       IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
    279          !                       ! now that the file has been opened in call to mynode.  
    280          !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    281          WRITE( numond, namctl ) 
    282          WRITE( numond, namcfg ) 
    283          IF( .NOT.ln_read_cfg ) THEN 
    284             DO ji = 1, SIZE(clnam) 
    285                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    286             END DO 
     238         IF( lwm )   CALL ctl_opn(     numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     239         ! open reference and configuration namelist files 
     240                     CALL ctl_opn( numnam_ref,            'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     241                     CALL ctl_opn( numnam_cfg,            'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     242         IF( lwm )   CALL ctl_opn(     numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     243      ENDIF 
     244      ! open /dev/null file to be able to supress output write easily 
     245                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     246      ! 
     247      !                             !--------------------! 
     248      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     249      !                             !--------------------! 
     250      ! 
     251      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
     252      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
     253901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
     254      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
     255      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
     256902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     257      ! 
     258      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     259      ! 
     260      IF(lwp) THEN                      ! open listing units 
     261         ! 
     262         IF( .NOT. lwm ) THEN           ! alreay opened for narea == 1 
     263            IF(lk_oasis) THEN   ;   CALL ctl_opn( numout,   'sas.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea ) 
     264            ELSE                ;   CALL ctl_opn( numout, 'ocean.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea ) 
     265            ENDIF 
    287266         ENDIF 
    288       ENDIF 
    289  
    290       IF(lwp) THEN                            ! open listing units 
    291          ! 
    292          IF( lk_oasis ) THEN   ;   CALL ctl_opn( numout,   'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 
    293          ELSE                  ;   CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea ) 
    294          ENDIF 
    295267         ! 
    296268         WRITE(numout,*) 
    297          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
     269         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
    298270         WRITE(numout,*) '                       NEMO team' 
    299271         WRITE(numout,*) '            Ocean General Circulation Model' 
     
    311283         WRITE(numout,*) "       )  )       \) |`\ \)  '.   \      (   (   " 
    312284         WRITE(numout,*) "      (  (           \_/       '-._\      )   )  " 
    313          WRITE(numout,*) "       )  )                        `     (   (   " 
     285         WRITE(numout,*) "       )  ) jgs                    `     (   (   " 
    314286         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    315287         WRITE(numout,*) 
    316          DO ji = 1, SIZE(cltxt) 
    317             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) cltxt(ji)    ! control print of mynode 
    318          END DO 
    319288         WRITE(numout,*) 
    320          WRITE(numout,*) 
    321          DO ji = 1, SIZE(cltxt2) 
    322             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) cltxt2(ji)   ! control print of domain size 
    323          END DO 
    324289         ! 
    325290         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    326291         ! 
    327292      ENDIF 
    328       ! open /dev/null file to be able to supress output write easily 
    329       CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    330       ! 
    331       !                                      ! Domain decomposition 
    332       CALL mpp_init                          ! MPP 
     293     ! 
     294      ! finalize the definition of namctl variables 
     295      IF( sn_cfctl%l_config ) THEN 
     296         ! Activate finer control of report outputs 
     297         ! optionally switch off output from selected areas (note this only 
     298         ! applies to output which does not involve global communications) 
     299         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
     300           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
     301           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     302      ELSE 
     303         ! Use ln_ctl to turn on or off all options. 
     304         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
     305      ENDIF 
     306      ! 
     307      IF(lwm) WRITE( numond, namctl ) 
     308      ! 
     309      !                             !------------------------------------! 
     310      !                             !  Set global domain size parameters ! 
     311      !                             !------------------------------------! 
     312      ! 
     313      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     314      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     315903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     316      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     317      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     318904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     319      ! 
     320      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
     321         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     322      ELSE                              ! user-defined namelist 
     323         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     324      ENDIF 
     325      ! 
     326      IF(lwm)   WRITE( numond, namcfg ) 
     327      ! 
     328      !                             !-----------------------------------------! 
     329      !                             ! mpp parameters and domain decomposition ! 
     330      !                             !-----------------------------------------! 
     331      CALL mpp_init 
    333332 
    334333      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    467466      ! 
    468467      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
    469          &                                                'Compile with key_nosignedzero enabled' ) 
     468         &                                                'Compile with key_nosignedzero enabled:',   & 
     469         &                                                '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' ) 
    470470      ! 
    471471#if defined key_agrif 
Note: See TracChangeset for help on using the changeset viewer.