Changeset 1574 for IOIPSL

Timestamp:

11/10/11 09:21:23 (12 years ago)

Author:

mmaipsl

Message:

Add parallel getin_dump_para function for test all non-parallel getin.

File:

• IOIPSL/trunk/src/getincom.f90 (modified) (6 diffs)

IOIPSL/trunk/src/getincom.f90

@@ -13 +13 @@
 !-
 PRIVATE
-PUBLIC :: getin_name, getin, getin_dump
+PUBLIC :: getin_name, getin, getin_dump, getin_dump_para
 !-
 !!--------------------------------------------------------------------
@@ -65 +65 @@
 !! (C) fileprefix : allows the user to change the name of the file
 !!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+!!------------------------------------------------------------------------
+!! Parallel version of getin_dump : user must give a fileprefix and a rank.
+!! It may be usefull to verify that only the root proc is reading the input
+!! def files.
+!!
+!!  SUBROUTINE getin_dump_para (fileprefix,rank)
+!!
+!! INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!! (I) rank : the rank of the parallel process (only 0-999 files will be created)
 !!--------------------------------------------------------------------
 !-
@@ -1241 +1255 @@
 !-
   INTEGER :: current,nb_lastkey
-  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+  CHARACTER(LEN=*) :: key_str,NEW_str
+  CHARACTER(LEN=*),INTENT(out) :: last_key
 !-
 ! LOCAL
@@ -1478 +1493 @@
   INTEGER :: unit,eof,nb_lastkey
   CHARACTER(LEN=100) :: dummy
-  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=100),INTENT(out) :: out_string
   CHARACTER(LEN=1) :: first
 !---------------------------------------------------------------------
@@ -1840 +1855 @@
   CHARACTER(LEN=80) :: usedfileprefix
   INTEGER :: ikey,if,iff,iv
-  INTEGER :: ios
   CHARACTER(LEN=20) :: c_tmp
   CHARACTER(LEN=100) :: tmp_str,used_filename
@@ -2011 +2025 @@
 END SUBROUTINE getin_dump
 !===
+SUBROUTINE getin_dump_para (fileprefix,rank)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*) :: fileprefix
+  INTEGER,INTENT(IN) :: rank
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  LOGICAL :: l_dbg
+  INTEGER :: isize
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!---------------------------------------------------------------------
+  IF ( rank < 1000 ) THEN
+     isize=MIN(LEN_TRIM(fileprefix),75)
+     usedfileprefix = fileprefix(1:isize)
+     usedfileprefix((isize+1):(isize+1))='_'
+     WRITE(usedfileprefix((isize+2):(isize+5)),'(I4.4)') rank
+     IF (l_dbg) &
+          WRITE(ipslout,*) 'Dump getin to file ',usedfileprefix
+     CALL getin_dump(usedfileprefix)
+  ENDIF
+!------------------------
+END SUBROUTINE getin_dump_para
+
+!===
 SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
 !---------------------------------------------------------------------