/[lmdze]/trunk/libf/IOIPSL/getincom.f90
ViewVC logotype

Diff of /trunk/libf/IOIPSL/getincom.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 31 by guez, Thu Apr 1 09:07:28 2010 UTC revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC
# Line 2  MODULE getincom Line 2  MODULE getincom
2    
3    ! From getincom.f90,v 2.0 2004/04/05 14:47:48    ! From getincom.f90,v 2.0 2004/04/05 14:47:48
4    
5    USE stringop, ONLY : findpos,nocomma,cmpblank,strlowercase,gensig,find_sig    USE nocomma_m, ONLY : nocomma
6      use cmpblank_m, only: cmpblank
7      use strlowercase_m, only: strlowercase
8      use gensig_m, only: gensig
9      use find_sig_m, only: find_sig
10    
11    IMPLICIT NONE    IMPLICIT NONE
12    
13    PRIVATE    PRIVATE
14    PUBLIC :: getin, getin_dump    PUBLIC :: getin
15    
16    INTERFACE getin    INTERFACE getin
17       MODULE PROCEDURE getinrs, getinr1d, getinr2d, &       MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
# Line 2298  CONTAINS Line 2302  CONTAINS
2302      !----------------------------      !----------------------------
2303    END SUBROUTINE getin_allocmem    END SUBROUTINE getin_allocmem
2304    
   !****************************  
   
   SUBROUTINE getin_dump (fileprefix)  
     !---------------------------------------------------------------------  
     !- This subroutine will dump the content of the database into  file  
     !- which has the same format as the run.def. The idea is that the user  
     !- can see which parameters were used and re-use the file for another  
     !- run.  
     
     !- The argument file allows the user to change the name of the file  
     !- in which the data will be archived  
     !---------------------------------------------------------------------  
     
     CHARACTER(*),OPTIONAL :: fileprefix  
     
     CHARACTER(LEN=80) :: usedfileprefix = "used"  
     INTEGER :: ikey,if,iff,iv  
     CHARACTER(LEN=3) :: tmp3  
     CHARACTER(LEN=100) :: tmp_str, used_filename  
     LOGICAL :: check = .FALSE.  
     !---------------------------------------------------------------------  
     IF (PRESENT(fileprefix)) THEN  
        usedfileprefix = fileprefix(1:MIN(len_trim(fileprefix),80))  
     ENDIF  
     
     DO if=1,nbfiles  
        !---  
        used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))  
        IF (check) THEN  
           WRITE(*,*) &  
                &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if  
           WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys  
        ENDIF  
        OPEN(unit=76,file=used_filename)  
       
        !-- If this is the first file we need to add the list  
        !-- of file which belong to it  
       
        IF ( (if == 1) .AND. (nbfiles > 1) ) THEN  
           WRITE(76,*) '# '  
           WRITE(76,*) '# This file is linked to the following files :'  
           WRITE(76,*) '# '  
           DO iff=2,nbfiles  
              WRITE(76,*) 'INCLUDEDEF = ',TRIM(filelist(iff))  
           ENDDO  
           WRITE(76,*) '# '  
        ENDIF  
        !---  
        DO ikey=1,nb_keys  
           
           !---- Is this key form this file ?  
           
           IF (keyfromfile(ikey) == if) THEN  
             
              !---- Write some comments  
             
              WRITE(76,*) '#'  
              SELECT CASE (keystatus(ikey))  
              CASE(1)  
                 WRITE(76,*) '# Values of ', &  
                      &          TRIM(keystr(ikey)),' comes from the run.def.'  
              CASE(2)  
                 WRITE(76,*) '# Values of ', &  
                      &          TRIM(keystr(ikey)),' are all defaults.'  
              CASE(3)  
                 WRITE(76,*) '# Values of ', &  
                      &          TRIM(keystr(ikey)),' are a mix of run.def and defaults.'  
              CASE DEFAULT  
                 WRITE(76,*) '# Dont know from where the value of ', &  
                      &          TRIM(keystr(ikey)),' comes.'  
              END SELECT  
              WRITE(76,*) '#'  
             
              !---- Write the values  
             
              SELECT CASE (keytype(ikey))  
                 
              CASE(1)  
                 IF (keymemlen(ikey) == 1) THEN  
                    IF (keycompress(ikey) < 0) THEN  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),' = ',intmem(keymemstart(ikey))  
                    ELSE  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),' = ',keycompress(ikey), &  
                            &              ' * ',intmem(keymemstart(ikey))  
                    ENDIF  
                 ELSE  
                    DO iv=0,keymemlen(ikey)-1  
                       WRITE(tmp3,'(I3.3)') iv+1  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),'__',tmp3, &  
                            &              ' = ',intmem(keymemstart(ikey)+iv)  
                    ENDDO  
                 ENDIF  
                 
              CASE(2)  
                 IF (keymemlen(ikey) == 1) THEN  
                    IF (keycompress(ikey) < 0) THEN  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),' = ',realmem(keymemstart(ikey))  
                    ELSE  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),' = ',keycompress(ikey),&  
                            & ' * ',realmem(keymemstart(ikey))  
                    ENDIF  
                 ELSE  
                    DO iv=0,keymemlen(ikey)-1  
                       WRITE(tmp3,'(I3.3)') iv+1  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),'__',tmp3, &  
                            &              ' = ',realmem(keymemstart(ikey)+iv)  
                    ENDDO  
                 ENDIF  
              CASE(3)  
                 IF (keymemlen(ikey) == 1) THEN  
                    tmp_str = charmem(keymemstart(ikey))  
                    WRITE(76,*) TRIM(keystr(ikey)),' = ',TRIM(tmp_str)  
                 ELSE  
                    DO iv=0,keymemlen(ikey)-1  
                       WRITE(tmp3,'(I3.3)') iv+1  
                       tmp_str = charmem(keymemstart(ikey)+iv)  
                       WRITE(76,*) &  
                            &              TRIM(keystr(ikey)),'__',tmp3,' = ',TRIM(tmp_str)  
                    ENDDO  
                 ENDIF  
              CASE(4)  
                 IF (keymemlen(ikey) == 1) THEN  
                    IF (logicmem(keymemstart(ikey))) THEN  
                       WRITE(76,*) TRIM(keystr(ikey)),' = TRUE '  
                    ELSE  
                       WRITE(76,*) TRIM(keystr(ikey)),' = FALSE '  
                    ENDIF  
                 ELSE  
                    DO iv=0,keymemlen(ikey)-1  
                       WRITE(tmp3,'(I3.3)') iv+1  
                       IF (logicmem(keymemstart(ikey)+iv)) THEN  
                          WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = TRUE '  
                       ELSE  
                          WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = FALSE '  
                       ENDIF  
                    ENDDO  
                 ENDIF  
                 
              CASE DEFAULT  
                 WRITE(*,*) &  
                      &          'FATAL ERROR : Unknown type for variable ', &  
                      &          TRIM(keystr(ikey))  
                 STOP 'getin_dump'  
              END SELECT  
           ENDIF  
        ENDDO  
       
        CLOSE(unit=76)  
       
     ENDDO  
     !------------------------  
   END SUBROUTINE getin_dump  
   
2305  END MODULE getincom  END MODULE getincom
Legend:
Removed from v.31  
changed lines
  Added in v.32
  ViewVC Help
Powered by ViewVC 1.1.21