/[lmdze]/trunk/IOIPSL/Stringop/cmpblank.f90
ViewVC logotype

Annotation of /trunk/IOIPSL/Stringop/cmpblank.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 32 - (hide annotations)
Tue Apr 6 17:52:58 2010 UTC (14 years, 1 month ago) by guez
Original Path: trunk/libf/IOIPSL/Stringop/cmpblank.f90
File size: 625 byte(s)
Split "stringop.f90" into single-procedure files. Gathered files in directory
"IOIPSL/Stringop".

Split "flincom.f90" into "flincom.f90" and "flinget.f90". Removed
unused procedures from module "flincom". Removed unused argument
"filename" of procedure "flinopen_nozoom".

Removed unused files.

Split "grid_change.f90" into "grid_change.f90" and
"gr_phy_write_3d.f90".

Removed unused procedures from modules "calendar", "ioipslmpp",
"grid_atob", "gath_cpl" and "getincom". Removed unused procedures in
files "ppm3d.f" and "thermcell.f".

Split "mathelp.f90" into "mathelp.f90" and "mathop.f90".

Removed unused variable "dpres" of module "comvert".

Use argument "itau" instead of local variables "iadvtr" and "first" to
control algorithm in procedure "fluxstokenc".

Removed unused arguments of procedure "integrd".

Removed useless computations at the end of procedure "leapfrog".

Merged common block "matrfil" into module "parafilt".

1 guez 32 module cmpblank_m
2     contains
3 guez 30 SUBROUTINE cmpblank (str)
4     !---------------------------------------------------------------------
5     !-
6     !---------------------------------------------------------------------
7     CHARACTER(LEN=*),INTENT(inout) :: str
8     !-
9     INTEGER :: lcc,ipb
10     !---------------------------------------------------------------------
11     lcc = LEN_TRIM(str)
12     ipb = 1
13     DO
14     IF (ipb >= lcc) EXIT
15     IF (str(ipb:ipb+1) == ' ') THEN
16     str(ipb+1:) = str(ipb+2:lcc)
17     lcc = lcc-1
18     ELSE
19     ipb = ipb+1
20     ENDIF
21     ENDDO
22     !-------------------------
23     END SUBROUTINE cmpblank
24 guez 32 end module cmpblank_m

  ViewVC Help
Powered by ViewVC 1.1.21