*IF DEF,C91_2A SQRTHF2A.2 C ******************************COPYRIGHT****************************** GTS2F400.9451 C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9452 C GTS2F400.9453 C Use, duplication or disclosure of this code is subject to the GTS2F400.9454 C restrictions as set forth in the contract. GTS2F400.9455 C GTS2F400.9456 C Meteorological Office GTS2F400.9457 C London Road GTS2F400.9458 C BRACKNELL GTS2F400.9459 C Berkshire UK GTS2F400.9460 C RG12 2SZ GTS2F400.9461 C GTS2F400.9462 C If no contract has been raised with this copy of the code, the use, GTS2F400.9463 C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9464 C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9465 C Modelling at the above address. GTS2F400.9466 C ******************************COPYRIGHT****************************** GTS2F400.9467 C GTS2F400.9468 CLL Function SQRTHF SQRTHF2A.3 CLL SQRTHF2A.4 CLL Purpose: Portable verion of Cray library function to compute TS220993.90 CLL square root of ARG1 TS220993.91 CLL TS220993.92 CLL Tested under compiler: fort77 TS220993.93 CLL Tested under OS version: HP-UX A.08.07 TS220993.94 CLL SQRTHF2A.6 CLL Model Modification history: SQRTHF2A.7 CLL version Date SQRTHF2A.8 CLL 3.2 16/07/93 New deck. Tracey Smith. SQRTHF2A.9 CLL 3.3 22/09/93 Improved comments Tracey Smith TS220993.95 CLL TS220993.96 CLL Programming Standard: UM Doc Paper 3, version 5 (08/12/92) TS220993.97 CLL SQRTHF2A.10REAL FUNCTION SQRTHF(ARG1) ,1SQRTHF2A.11 IMPLICIT NONE SQRTHF2A.12 REAL ARG1 SQRTHF2A.13 IF(ARG1.LT.0) THEN SQRTHF2A.14 WRITE(6,*) 'Error: Attempt to SQRT a negative value' SQRTHF2A.15 CALL ABORT
SQRTHF2A.16 ELSE SQRTHF2A.17 SQRTHF=SQRT(ARG1) SQRTHF2A.18 END IF SQRTHF2A.19 END SQRTHF2A.20 *ENDIF SQRTHF2A.21