Oasis3 4.0.2
empty.f
Go to the documentation of this file.
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
 All Data Structures Namespaces Files Functions Variables Defines