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

Diff of /trunk/IOIPSL/getincom.f90

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

revision 51 by guez, Tue Sep 20 09:14:34 2011 UTC revision 72 by guez, Tue Jul 23 13:00:07 2013 UTC
# Line 5  MODULE getincom Line 5  MODULE getincom
5    use gensig_m, only: gensig    use gensig_m, only: gensig
6    use find_sig_m, only: find_sig    use find_sig_m, only: find_sig
7    use getincom2, only: nb_keys, keysig, keystr, getfill, getdbwl, getdbrl, &    use getincom2, only: nb_keys, keysig, keystr, getfill, getdbwl, getdbrl, &
8         getfilc, getdbwc, getdbrc, getfili, getdbwi, getdbri, getfilr, &         getfili, getdbwi, getdbri, getfilr, getdbwr, getdbrr
        getdbwr, getdbrr  
9    
10    IMPLICIT NONE    IMPLICIT NONE
11    
# Line 14  MODULE getincom Line 13  MODULE getincom
13    PUBLIC getin    PUBLIC getin
14    
15    INTERFACE getin    INTERFACE getin
16       MODULE PROCEDURE getinrs, getinr1d, getinr2d, getinis, getini1d, &       MODULE PROCEDURE getinrs, getinis, getinls
           getini2d, getincs, getinc1d, getinc2d, getinls, getinl1d, getinl2d  
17    END INTERFACE    END INTERFACE
18    
19  CONTAINS  CONTAINS
# Line 66  CONTAINS Line 64  CONTAINS
64    
65    !****************************    !****************************
66    
   SUBROUTINE getinr1d(MY_TARGET, ret_val)  
   
     ! See getinrs for details. It is the same thing but for a vector  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     REAL, DIMENSION(:) :: ret_val  
   
     REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, status=0, fileorig  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwr &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrr (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)  
   
   END SUBROUTINE getinr1d  
   
   !****************************  
   
   SUBROUTINE getinr2d(MY_TARGET, ret_val)  
   
     ! See getinrs for details. It is the same thing but for a matrix  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     REAL, DIMENSION(:, :) :: ret_val  
   
     REAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig  
     INTEGER :: jl, jj, ji  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     size_1 = SIZE(ret_val, 1)  
     size_2 = SIZE(ret_val, 2)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           tmp_ret_val(jl) = ret_val(ji, jj)  
        ENDDO  
     ENDDO  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfilr(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwr &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrr (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           ret_val(ji, jj) = tmp_ret_val(jl)  
        ENDDO  
     ENDDO  
   
   END SUBROUTINE getinr2d  
   
   !****************************  
   
67    SUBROUTINE getinis(MY_TARGET, ret_val)    SUBROUTINE getinis(MY_TARGET, ret_val)
68    
69      ! Get a interer scalar. We first check if we find it      ! Get a interer scalar. We first check if we find it
# Line 217  CONTAINS Line 104  CONTAINS
104    
105    !****************************    !****************************
106    
   SUBROUTINE getini1d(MY_TARGET, ret_val)  
   
     ! See getinis for details. It is the same thing but for a vector  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     INTEGER, DIMENSION(:) :: ret_val  
   
     INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, status=0, fileorig  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwi &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbri (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)  
   
   END SUBROUTINE getini1d  
   
   !****************************  
   
   SUBROUTINE getini2d(MY_TARGET, ret_val)  
   
     ! See getinis for details. It is the same thing but for a matrix  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     INTEGER, DIMENSION(:, :) :: ret_val  
   
     INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig  
     INTEGER :: jl, jj, ji  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     size_1 = SIZE(ret_val, 1)  
     size_2 = SIZE(ret_val, 2)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           tmp_ret_val(jl) = ret_val(ji, jj)  
        ENDDO  
     ENDDO  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfili(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwi &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbri (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           ret_val(ji, jj) = tmp_ret_val(jl)  
        ENDDO  
     ENDDO  
   
   END SUBROUTINE getini2d  
   
   !****************************  
   
   !=== CHARACTER INTERFACES  
   
   SUBROUTINE getincs(MY_TARGET, ret_val)  
   
     ! Get a CHARACTER scalar. We first check if we find it  
     ! in the database and if not we get it from the run.def  
   
     ! getinc1d and getinc2d are written on the same pattern  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     CHARACTER(LEN=*) :: ret_val  
   
     CHARACTER(LEN=100), DIMENSION(1) :: tmp_ret_val  
     INTEGER :: target_sig, pos, status=0, fileorig  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     tmp_ret_val(1) = ret_val  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwc(MY_TARGET, target_sig, status, fileorig, 1, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrc (pos, 1, MY_TARGET, tmp_ret_val)  
     ENDIF  
     ret_val = tmp_ret_val(1)  
   
   END SUBROUTINE getincs  
   
   !****************************  
   
   SUBROUTINE getinc1d(MY_TARGET, ret_val)  
   
     ! See getincs for details. It is the same thing but for a vector  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     CHARACTER(LEN=*), DIMENSION(:) :: ret_val  
   
     CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, status=0, fileorig  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwc &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrc (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)  
   
   END SUBROUTINE getinc1d  
   
   !****************************  
   
   SUBROUTINE getinc2d(MY_TARGET, ret_val)  
   
     ! See getincs for details. It is the same thing but for a matrix  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     CHARACTER(LEN=*), DIMENSION(:, :) :: ret_val  
   
     CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig  
     INTEGER :: jl, jj, ji  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     size_1 = SIZE(ret_val, 1)  
     size_2 = SIZE(ret_val, 2)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           tmp_ret_val(jl) = ret_val(ji, jj)  
        ENDDO  
     ENDDO  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfilc(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwc &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrc (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           ret_val(ji, jj) = tmp_ret_val(jl)  
        ENDDO  
     ENDDO  
   
   END SUBROUTINE getinc2d  
   
   !****************************  
   
107    !=== LOGICAL INTERFACES    !=== LOGICAL INTERFACES
108    
109    SUBROUTINE getinls(MY_TARGET, ret_val)    SUBROUTINE getinls(MY_TARGET, ret_val)
# Line 525  CONTAINS Line 148  CONTAINS
148    
149    END SUBROUTINE getinls    END SUBROUTINE getinls
150    
   !****************************  
   
   SUBROUTINE getinl1d(MY_TARGET, ret_val)  
   
     ! See getinls for details. It is the same thing but for a vector  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     LOGICAL, DIMENSION(:) :: ret_val  
   
     LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, status=0, fileorig  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
     tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwl &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrl (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
     ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)  
   
   END SUBROUTINE getinl1d  
   
   !****************************  
   
   SUBROUTINE getinl2d(MY_TARGET, ret_val)  
   
     ! See getinls for details. It is the same thing but for a matrix  
   
   
     CHARACTER(LEN=*) :: MY_TARGET  
     LOGICAL, DIMENSION(:, :) :: ret_val  
   
     LOGICAL, DIMENSION(:), ALLOCATABLE, SAVE :: tmp_ret_val  
     INTEGER, SAVE :: tmp_ret_size = 0  
     INTEGER :: target_sig, pos, size_of_in, size_1, size_2, status=0, fileorig  
     INTEGER :: jl, jj, ji  
   
   
     ! Compute the signature of the target  
   
     CALL gensig(MY_TARGET, target_sig)  
   
     ! Do we have this target in our database ?  
   
     CALL find_sig (nb_keys, keystr, my_target, keysig, target_sig, pos)  
   
     size_of_in = SIZE(ret_val)  
     size_1 = SIZE(ret_val, 1)  
     size_2 = SIZE(ret_val, 2)  
     IF (.NOT.ALLOCATED(tmp_ret_val)) THEN  
        ALLOCATE (tmp_ret_val(size_of_in))  
     ELSE IF (size_of_in > tmp_ret_size) THEN  
        DEALLOCATE (tmp_ret_val)  
        ALLOCATE (tmp_ret_val(size_of_in))  
        tmp_ret_size = size_of_in  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           tmp_ret_val(jl) = ret_val(ji, jj)  
        ENDDO  
     ENDDO  
   
     IF (pos < 0) THEN  
        ! Ge the information out of the file  
        CALL getfill(MY_TARGET, status, fileorig, tmp_ret_val)  
        ! Put the data into the database  
        CALL getdbwl &  
             & (MY_TARGET, target_sig, status, fileorig, size_of_in, tmp_ret_val)  
     ELSE  
        ! Get the value out of the database  
        CALL getdbrl (pos, size_of_in, MY_TARGET, tmp_ret_val)  
     ENDIF  
   
     jl=0  
     DO jj=1, size_2  
        DO ji=1, size_1  
           jl=jl+1  
           ret_val(ji, jj) = tmp_ret_val(jl)  
        ENDDO  
     ENDDO  
   
   END SUBROUTINE getinl2d  
   
151  END MODULE getincom  END MODULE getincom
Legend:
Removed from v.51  
changed lines
  Added in v.72
  ViewVC Help
Powered by ViewVC 1.1.21