1C Copyright 1981-2016 ECMWF. 2C 3C This software is licensed under the terms of the Apache Licence 4C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. 5C 6C In applying this licence, ECMWF does not waive the privileges and immunities 7C granted to it by virtue of its status as an intergovernmental organisation 8C nor does it submit to any jurisdiction. 9C 10 11 SUBROUTINE ABORTX (HNAME) 12C 13C----> 14C**** ABORTX - Terminates execution of program. 15C 16C Purpose. 17C -------- 18C 19C Terminates execution of program. 20C 21C** Interface. 22C ---------- 23C 24C CALL ABORTX (HNAME) 25C 26C 27C Input Parameters. 28C ----------------- 29C 30C HNAME - Name of calling routine. 31C 32C Output Parameters. 33C ------------------ 34C 35C None. 36C 37C Method. 38C ------- 39C 40C Prints message and terminates. 41C 42C Externals. 43C ---------- 44C 45#if defined(VAX) || defined(__PGI) 46C EXIT (VAX/PGI Fortran) 47#elif (defined IBM) && (!defined rs6000) 48C SYSABN (IBM) 49#elif defined(CRAY) 50C ABORT (Cray) 51#elif defined(sun) || defined (sgi) || (defined rs6000) 52C ABORT (SUN/SGI) 53#elif defined(CYBER) 54C ABORT (Cyber) 55#elif defined(__uxp__) 56C ABORT (Fujitsu) 57#elif defined(__hpux) 58C JABORT (C) 59#endif 60C 61C Reference. 62C ---------- 63C 64C None. 65C 66C Comments. 67C --------- 68C 69C None. 70C 71C Author. 72C ------- 73C 74C J. Hennessy ECMWF 13.11.91 75C 76C Modifications. 77C -------------- 78C 79C None. 80C 81C----< 82C 83 IMPLICIT NONE 84C 85#include "common/grprs.h" 86C 87 CHARACTER*(*) HNAME 88C 89C ------------------------------------------------------------------ 90C* Section 1 . Print message and terminate. 91C ------------------------------------------------------------------ 92C 93 100 CONTINUE 94C 95 WRITE(GRPRSM,9001) HNAME 96C 97#if defined(VAX) || defined(__PGI) 98 CALL EXIT (-1) 99#elif (defined IBM) && (!defined rs6000) 100 CALL SYSABN (1) 101#elif defined(CRAY) 102 CALL ABORT 103#elif defined(sun) || defined (sgi) || (defined rs6000) 104 CALL ABORT 105#elif defined(CYBER) 106 CALL ABORT ('US',0,' ') 107#elif defined(__uxp__) 108 CALL ABORT 109#elif defined(__hpux) 110 CALL JABORT 111#endif 112C Ensure termination and non-zero return if external doesn't 113C (STOP is intrinsic) 114 STOP 1 115C 116C ------------------------------------------------------------------ 117C* Section 9 . Format statements. 118C ------------------------------------------------------------------ 119C 120 900 CONTINUE 121C 122 9001 FORMAT (1H ,'ABORTX : Routine ',A,' has requested program', 123 C ' termination.') 124C 125 RETURN 126C 127 END 128 129