Oasis3 4.0.2
|
00001 SUBROUTINE empty (cdchar, klen) 00002 C**** 00003 C ****************************** 00004 C * OASIS FUNCTION - LEVEL T * 00005 C * -------------- ------- * 00006 C ****************************** 00007 C 00008 C**** *empty* - Utility routine 00009 C 00010 C Purpose: 00011 C ------- 00012 C Fill up a character string with blanks 00013 C 00014 C** Interface: 00015 C --------- 00016 C *call* *empty (cdchar, klen)* 00017 C 00018 C Input: 00019 C ----- 00020 C cdchar : string to be filled up with blanks (char string) 00021 C klen : string length (integer) 00022 C 00023 C Output: 00024 C ------ 00025 C cdchar : string filled up with blanks 00026 C 00027 C Workspace: 00028 C --------- 00029 C None 00030 C 00031 C Externals: 00032 C --------- 00033 C None 00034 C 00035 C Reference: 00036 C --------- 00037 C See OASIS manual (1995) 00038 C 00039 C History: 00040 C ------- 00041 C Version Programmer Date Description 00042 C ------- ---------- ---- ----------- 00043 C 2.0 L. Terray 95/09/01 created 00044 C 00045 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00046 C 00047 C* ---------------------------- Include files --------------------------- 00048 C 00049 USE mod_unit 00050 USE mod_printing 00051 C 00052 C* ---------------------------- Argument declarations ------------------- 00053 C 00054 CHARACTER*1 cdchar 00055 DIMENSION cdchar(klen) 00056 C 00057 C* ---------------------------- Local declarations ------------------- 00058 C 00059 CHARACTER (len=1), SAVE :: clblank = ' ' 00060 C 00061 C* ---------------------------- Poema verses ---------------------------- 00062 C 00063 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00064 C 00065 IF (nlogprt .GE. 2) THEN 00066 WRITE (UNIT = nulou,FMT = *) '****** * Entering ROUTINE empty' 00067 call flush(nulou) 00068 ENDIF 00069 C 00070 C* 1. Fill s1 with blanks 00071 C ------------------- 00072 C 00073 DO 110 ji = 1, klen 00074 cdchar(ji) = clblank 00075 110 CONTINUE 00076 C 00077 C 00078 C* 2. End of routine 00079 C -------------- 00080 C 00081 IF (nlogprt .GE. 2) THEN 00082 WRITE (UNIT = nulou,FMT = *) '********* Leaving ROUTINE empty' 00083 call flush(nulou) 00084 ENDIF 00085 RETURN 00086 END