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 474 for trunk/NEMO/OPA_SRC/OBC – NEMO

Changeset 474 for trunk/NEMO/OPA_SRC/OBC


Ignore:
Timestamp:
2006-05-11T17:24:19+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_061: SM: end of ctl_stop + mpi optimization in _bilap

Location:
trunk/NEMO/OPA_SRC/OBC
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/OBC/obcdom.F90

    r247 r474  
    109109      ! ------------------------------------------------ 
    110110       
    111       IF( nbobc == 1 .OR. nbic == 0 ) THEN  
    112          IF(lwp) WRITE(numout,*) 
    113          IF(lwp) WRITE(numout,*) ' obc_dom: No isolated coastlines gcfobc is set to zero' 
    114          IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    115          nstop = nstop + 1 
    116       END IF 
     111      IF( nbobc == 1 .OR. nbic == 0 ) CALL ctl_stop( ' obc_dom: No isolated coastlines gcfobc is set to zero' ) 
    117112 
    118113      ! 2. Lecture of 'coastlines' file 
    … …  
    190185 
    191186      IF( icheck /= 0 ) THEN 
    192          IF(lwp) WRITE(numout,cform_err) 
    193          IF(lwp) WRITE(numout,*) 'obc_dom : tmask and isolated coastlines mask are not equal', icheck 
    194          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    195          nstop = nstop + 1 
     187         WRITE(ctmp1,*) 'obc_dom : tmask and isolated coastlines mask are not equal', icheck 
     188    CALL ctl_stop( ctmp1 ) 
    196189      END IF 
    197190 
    … …  
    350343      DO jnic = 1, nbobc-1 
    351344         IF( mnic(0,jnic) > jpnic ) THEN 
    352             IF(lwp) WRITE(numout,cform_err) 
    353             IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   & 
    354                ' has ',ip,' grid-points > ',jpnic  
    355             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    356             IF(lwp) WRITE(numout,*) ' modify this dimension in obc_dom' 
    357             nstop = nstop + 1 
     345            WRITE(ctmp1,*) 'obc_dom: isolated coastline ',jnic,' has ',ip,' grid-points > ',jpnic  
     346            CALL ctl_stop( ctmp1 ) 
    358347         END IF 
    359348         IF( mnic(0,jnic) == 0 ) THEN 
    360             IF(lwp) WRITE(numout,cform_err) 
    361             IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   & 
    362                ' has 0  grid-points verify coastlines file' 
    363             IF(lwp) WRITE(numout,*) '~~~~~~~' 
    364             nstop = nstop + 1 
     349            WRITE(ctmp1,*) 'obc_dom: isolated coastline ',jnic,' has 0  grid-points verify coastlines file' 
     350            CALL ctl_stop( ctmp1 ) 
    365351         END IF 
    366352      END DO 

  • trunk/NEMO/OPA_SRC/OBC/obcini.F90

    r416 r474  
    122122      IF(lwp) WRITE(numout,*) '         Number of open boundaries    nbobc = ',nbobc 
    123123      IF(lwp) WRITE(numout,*) 
    124       IF( nbobc /= 0 .AND. jperio /= 0 ) THEN 
    125          IF(lwp) WRITE(numout,*) 
    126          IF(lwp) WRITE(numout,*) ' E R R O R : Cyclic or symmetric,',   & 
    127             ' and open boundary condition are not compatible' 
    128          IF(lwp) WRITE(numout,*) ' ========== ' 
    129          IF(lwp) WRITE(numout,*) 
    130          nstop = nstop + 1 
    131       END IF 
     124      IF( nbobc /= 0 .AND. jperio /= 0 ) & 
     125           &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    132126 
    133127      ! control prints 
    … …  
    204198            inumfbc = inumfbc+1 
    205199         ELSEIF ( (rdpein*rdpeob) == 0 )  THEN 
    206             IF(lwp) THEN 
    207                WRITE(numout,cform_err) 
    208                WRITE(numout,*) 'obc_init : rdpein & rdpeob must be both zero or non zero' 
    209                nstop = nstop + 1 
    210             ENDIF 
     200            CALL ctl_stop( 'obc_init : rdpein & rdpeob must be both zero or non zero' ) 
    211201         END IF 
    212202      END IF 
    … …  
    218208            inumfbc = inumfbc+1 
    219209         ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN 
    220             IF(lwp) THEN 
    221                WRITE(numout,cform_err) 
    222                WRITE(numout,*) 'obc_init : rdpwin & rdpwob must be both zero or non zero' 
    223                nstop = nstop + 1 
    224             ENDIF 
     210            CALL ctl_stop( 'obc_init : rdpwin & rdpwob must be both zero or non zero' ) 
    225211         END IF 
    226212      END IF 
    … …  
    232218            inumfbc = inumfbc+1 
    233219         ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN 
    234             IF(lwp) THEN 
    235                WRITE(numout,cform_err) 
    236                WRITE(numout,*) 'obc_init : rdpnin & rdpnob must be both zero or non zero' 
    237                nstop = nstop + 1 
    238             ENDIF 
     220            CALL ctl_stop( 'obc_init : rdpnin & rdpnob must be both zero or non zero' ) 
    239221         END IF 
    240222      END IF 
    … …  
    246228            inumfbc = inumfbc+1 
    247229         ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN 
    248             IF(lwp) THEN 
    249                WRITE(numout,cform_err) 
    250                WRITE(numout,*) 'obc_init : rdpsin & rdpsob must be both zero or non zero' 
    251                nstop = nstop + 1 
    252             ENDIF 
     230            CALL ctl_stop( 'obc_init : rdpsin & rdpsob must be both zero or non zero' ) 
    253231         END IF 
    254232      END IF 
    … …  
    605583      IF( lp_obc_west ) THEN 
    606584         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN 
    607             IF(lwp) WRITE(numout,*) 
    608             IF(lwp) WRITE(numout,*) ' E R R O R : jpiwob exceed ', jpiglo-2, 'or less than 2' 
    609             IF(lwp) WRITE(numout,*) ' ========== ' 
    610             IF(lwp) WRITE(numout,*) 
    611             nstop = nstop + 1 
     585            WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2' 
     586            CALL ctl_stop( ctmp1 ) 
    612587         END IF 
    613588         ztestmask(:)=0. 
    … …  
    625600      IF( lp_obc_east ) THEN 
    626601         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN 
    627             IF(lwp) WRITE(numout,*) 
    628             IF(lwp) WRITE(numout,*) ' E R R O R : jpieob exceed ', jpiglo, ' or less than 4' 
    629             IF(lwp) WRITE(numout,*) ' ========== ' 
    630             IF(lwp) WRITE(numout,*) 
    631             nstop = nstop + 1 
     602            WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4' 
     603            CALL ctl_stop( ctmp1 ) 
    632604         END IF 
    633605         ztestmask(:)=0. 
    … …  
    645617      IF( lp_obc_north ) THEN 
    646618         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN 
    647             IF(lwp) WRITE(numout,*) 
    648             IF(lwp) WRITE(numout,*) ' E R R O R : jpjnob exceed ', jpjglo, ' or less than 4' 
    649             IF(lwp) WRITE(numout,*) ' ========== ' 
    650             IF(lwp) WRITE(numout,*) 
    651             nstop = nstop + 1 
     619            WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4' 
     620            CALL ctl_stop( ctmp1 ) 
    652621         END IF 
    653622         ztestmask(:)=0. 
    … …  
    665634      IF( lp_obc_south ) THEN 
    666635         IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN 
    667             IF(lwp) WRITE(numout,*) 
    668             IF(lwp) WRITE(numout,*) ' E R R O R : jpjsob exceed ', jpjglo-2, ' or less than 2' 
    669             IF(lwp) WRITE(numout,*) ' ========== ' 
    670             IF(lwp) WRITE(numout,*) 
    671             nstop = nstop + 1 
     636            WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2' 
     637            CALL ctl_stop( ctmp1 ) 
    672638         END IF 
    673639         ztestmask(:)=0. 
    … …  
    687653         IF(lwp) WRITE(numout,*) ' ========== ' 
    688654         IF(lwp) WRITE(numout,*) 
    689          IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) THEN 
    690             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    691             nstop = nstop + 1 
    692          END IF 
     655         IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) & 
     656              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
     657 
    693658      ELSE IF( icorner(1) == 1 ) THEN 
    694               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SW corner, we stop' 
    695               nstop = nstop + 1 
     659         CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' ) 
    696660      END IF  
    697661 
    … …  
    701665          IF(lwp) WRITE(numout,*) ' ========== ' 
    702666          IF(lwp) WRITE(numout,*) 
    703           IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) THEN 
    704              IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    705              nstop = nstop + 1 
    706           END IF 
     667          IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) & 
     668               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    707669      ELSE IF( icorner(2) == 1 ) THEN 
    708               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SE corner, we stop' 
    709               nstop = nstop + 1 
     670         CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' ) 
    710671      END IF  
    711672 
    … …  
    715676         IF(lwp) WRITE(numout,*) ' ========== ' 
    716677         IF(lwp) WRITE(numout,*) 
    717          IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) THEN 
    718             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    719             nstop = nstop + 1 
    720          END IF 
     678         IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) & 
     679              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    721680       ELSE IF( icorner(3) == 1 ) THEN 
    722                IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NE corner, we stop' 
    723                nstop = nstop + 1 
     681          CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' ) 
    724682       END IF  
    725683 
    … …  
    729687         IF(lwp) WRITE(numout,*) ' ========== ' 
    730688         IF(lwp) WRITE(numout,*) 
    731          IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) THEN 
    732             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop' 
    733             nstop = nstop + 1 
    734          END IF 
     689         IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) & 
     690              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' ) 
    735691       ELSE IF( icorner(4) == 1 ) THEN 
    736                IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NW corner, we stop' 
    737                nstop = nstop + 1 
     692          CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' ) 
    738693       END IF  
    739694 
    … …  
    792747            ! ... stop if  e r r o r (s)   detected 
    793748            IF( istop /= 0 ) THEN 
    794                IF(lwp)WRITE(numout,*) 
    795                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    796                IF(lwp)WRITE(numout,*) ' =============== ' 
    797                IF(lwp)WRITE(numout,*) 
    798                nstop = nstop + 1 
     749               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     750               CALL ctl_stop( ctmp1 ) 
    799751            ENDIF 
    800752         ENDIF 
    … …  
    821773            ! ... stop if  e r r o r (s)   detected 
    822774            IF( istop /= 0 ) THEN 
    823                IF(lwp)WRITE(numout,*) 
    824                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    825                IF(lwp)WRITE(numout,*) ' =============== ' 
    826                IF(lwp)WRITE(numout,*) 
    827                nstop = nstop + 1 
     775               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     776               CALL ctl_stop( ctmp1 ) 
    828777            ENDIF 
    829778         ENDIF 
    … …  
    850799            ! ... stop if  e r r o r (s)   detected 
    851800            IF( istop /= 0 ) THEN 
    852                IF(lwp)WRITE(numout,*) 
    853                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    854                IF(lwp)WRITE(numout,*) ' =============== ' 
    855                IF(lwp)WRITE(numout,*) 
    856                nstop = nstop + 1 
    857             ENDIF 
     801                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     802               CALL ctl_stop( ctmp1 ) 
     803           ENDIF 
    858804         ENDIF 
    859805      ENDIF 
    … …  
    879825            ! ... stop if  e r r o r (s)   detected 
    880826            IF( istop /= 0 ) THEN 
    881                IF(lwp)WRITE(numout,*) 
    882                IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop' 
    883                IF(lwp)WRITE(numout,*) ' =============== ' 
    884                IF(lwp)WRITE(numout,*) 
    885                nstop = nstop + 1 
     827               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' 
     828               CALL ctl_stop( ctmp1 ) 
    886829            ENDIF 
    887830         ENDIF 

  • trunk/NEMO/OPA_SRC/OBC/obcrst.F90

    r367 r474  
    102102               RECL   =  nreclo,              & 
    103103               FORM   = 'UNFORMATTED' ) 
    104          IF( ios > 0 ) THEN 
    105             IF(lwp) WRITE(numout,*) '      ' 
    106             IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc.output file '  
    107             IF(lwp) WRITE(numout,*) '      ' 
    108             nstop = nstop + 1    
    109          END IF 
    110  
     104         IF( ios > 0 ) CALL ctl_stop( '        Pbm to OPEN the restart.obc.output file ' ) 
     105  
    111106         ! 1.2 Write header 
    112107         ! ---------------- 
    … …  
    363358            RECL   =  nreclo,       & 
    364359            FORM   = 'UNFORMATTED' ) 
    365       IF( ios > 0 ) THEN 
    366          IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc file '  
    367          nstop = nstop + 1    
    368       END IF 
     360      IF( ios > 0 ) CALL ctl_stop( '        Pbm to OPEN the restart.obc file ' ) 
    369361 
    370362      ! 1. Read 
    … …  
    385377      ! -------------------- 
    386378      IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN 
    387           IF(lwp) THEN 
    388              WRITE(numout,*) '        ===>>>> : problem with nit000 for the restart' 
    389              WRITE(numout,*) '        ==============' 
    390              WRITE(numout,*) '        we stop in obc_rst_lec routine. Verify the file or rerun with the value' 
    391              WRITE(numout,*) '        0 for the control of time parameter nrstdt' 
    392              WRITE(numout,*) ' '  
    393           END IF 
    394           nstop = nstop + 1 
     379          CALL ctl_stop( '        ===>>>> : problem with nit000 for the restart',   & 
     380               &         '        ==============',   & 
     381               &         '        we stop in obc_rst_lec routine. Verify the file or rerun with the value',   & 
     382               &         '        0 for the control of time parameter nrstdt' ) 
     383              
    395384      END IF 
    396385  
    … …  
    411400            WRITE(numout,*) '         ' 
    412401            WRITE(numout,*) '        East open boundary' 
    413             IF( jpieob0 /= jpieob1 ) THEN 
    414                WRITE(numout,*) '         ==>>>> : Problem in obc_rst_lec, jpieob have changed' 
    415                nstop = nstop + 1 
    416             END IF 
     402            IF( jpieob0 /= jpieob1 ) CALL ctl_stop( '         ==>>>> : Problem in obc_rst_lec, jpieob have changed' ) 
    417403         END IF 
    418404      END IF 
    … …  
    422408            WRITE(numout,*) '         ' 
    423409            WRITE(numout,*) '        West open boundary' 
    424             IF( jpiwob0 /= jpiwob1 ) THEN 
    425                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed' 
    426                nstop = nstop + 1 
    427             END IF 
     410            IF( jpiwob0 /= jpiwob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed' ) 
    428411         END IF 
    429412      END IF 
    … …  
    433416            WRITE(numout,*) '         ' 
    434417            WRITE(numout,*) '        North open boundary' 
    435             IF( jpjnob0 /= jpjnob1 ) THEN 
    436                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed' 
    437                nstop = nstop + 1 
    438             END IF 
     418            IF( jpjnob0 /= jpjnob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed' ) 
    439419         END IF 
    440420      END IF 
    … …  
    444424            WRITE(numout,*) '         ' 
    445425            WRITE(numout,*) '        South open boundary' 
    446             IF( jpjsob0 /= jpjsob1) THEN 
    447                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed' 
    448                nstop = nstop + 1 
    449             END IF 
     426            IF( jpjsob0 /= jpjsob1) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed' ) 
    450427         END IF 
    451428      END IF 
    … …  
    455432      ! ------------------------------------------ 
    456433      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN 
    457          IF(lwp) THEN 
    458             IF( ied1 /= ied0 ) THEN 
    459                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjed has changed' 
    460                nstop = nstop + 1 
    461             END IF 
    462             IF( ief1 /= ief0 ) THEN 
    463                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjef has changed' 
    464                nstop = nstop + 1 
    465             END IF 
    466          END IF 
     434         IF( ied1 /= ied0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjed has changed' ) 
     435         IF( ief1 /= ief0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjef has changed' ) 
    467436      END IF 
    468437 
    469438      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN 
    470          IF(lwp) THEN 
    471             IF( iwd1 /= iwd0 ) THEN 
    472                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed' 
    473                nstop = nstop + 1 
    474             END IF 
    475             IF( iwf1 /= iwf0 ) THEN 
    476                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed' 
    477                nstop = nstop + 1 
    478             END IF 
    479          END IF 
     439         IF( iwd1 /= iwd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed' ) 
     440         IF( iwf1 /= iwf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed' ) 
    480441      END IF 
    481442  
    482443      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN 
    483          IF(lwp) THEN 
    484             IF( ind1 /= ind0 ) THEN 
    485                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpind has changed' 
    486                nstop = nstop + 1 
    487             END IF 
    488             IF( inf1 /= inf0 ) THEN 
    489                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpinf has changed' 
    490                nstop = nstop + 1 
    491              END IF 
    492           END IF 
     444         IF( ind1 /= ind0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpind has changed' ) 
     445         IF( inf1 /= inf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpinf has changed' ) 
    493446      END IF 
    494447  
    495448      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN 
    496          IF(lwp) THEN 
    497             IF( isd1 /= isd0 ) THEN 
    498                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisd has changed' 
    499                nstop = nstop + 1 
    500             END IF 
    501             IF( isf1 /= isf0 ) THEN 
    502                WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisf has changed' 
    503                nstop = nstop + 1 
    504             END IF 
    505          END IF 
     449         IF( isd1 /= isd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpisd has changed' ) 
     450         IF( isf1 /= isf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_lec, jpisf has changed' ) 
    506451      END IF 
    507452  
Note: See TracChangeset for help on using the changeset viewer.