Changeset 862


Ignore:
Timestamp:
05/09/19 01:29:34 (5 years ago)
Author:
dubos
Message:

devel : refactored base/field.f90

File:
1 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/devel/src/base/field.f90

    r839 r862  
    4444  END INTERFACE 
    4545 
    46   PRIVATE :: allocate_field_ 
     46  PRIVATE :: allocate_field_, deallocate_field_ 
    4747 
    4848CONTAINS 
    … …  
    6161!$OMP END MASTER 
    6262!$OMP BARRIER 
    63     CALL allocate_field_(field,field_type,data_type,dim1,dim2,name) 
     63    CALL allocate_field_(domain,assigned_domain, field,field_type,data_type,dim1,dim2,name) 
     64!$OMP BARRIER 
    6465  END SUBROUTINE allocate_field 
    6566 
    … …  
    8081!$OMP BARRIER 
    8182    DO i=1,nfield 
    82        CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name) 
     83       CALL allocate_field_(domain,assigned_domain, field(:,i),field_type,data_type,dim1,dim2,name) 
    8384    END DO 
     85!$OMP BARRIER 
    8486  END SUBROUTINE allocate_fields 
    8587 
    86   SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name) 
     88  SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name) 
     89    USE domain_mod 
     90    IMPLICIT NONE 
     91    TYPE(t_field),POINTER :: field(:) 
     92    INTEGER,INTENT(IN) :: field_type 
     93    INTEGER,INTENT(IN) :: data_type 
     94    INTEGER,OPTIONAL :: dim1,dim2 
     95    CHARACTER(*), OPTIONAL :: name 
     96    INTEGER :: ind 
     97    INTEGER :: ii_size,jj_size 
     98    LOGICAL :: assigned_dom(ndomain_glo) 
     99    ! ONLY the master thread is allowed to call this routine 
     100 
     101    ALLOCATE(field(ndomain_glo))     
     102    assigned_dom(:)=.TRUE. 
     103    CALL allocate_field_(domain_glo,assigned_dom, field,field_type,data_type,dim1,dim2,name)   
     104 
     105  END SUBROUTINE allocate_field_glo 
     106 
     107  SUBROUTINE allocate_field_(dom,assigned_dom, field,field_type,data_type,dim1,dim2,name)  
    87108    USE domain_mod 
    88109    USE omp_para 
    89     USE grid_param 
     110    TYPE(t_domain), INTENT(IN) :: dom(:) 
     111    LOGICAL, INTENT(IN) :: assigned_dom(:) 
    90112    TYPE(t_field) :: field(:) 
    91113    INTEGER,INTENT(IN) :: field_type 
    … …  
    94116    CHARACTER(*), OPTIONAL :: name 
    95117    INTEGER :: ind 
    96     INTEGER :: ij_size 
    97  
    98     DO ind=1,ndomain 
    99       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
     118 
     119    DO ind=1,SIZE(field) 
     120      IF (.NOT. assigned_dom(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
    100121 
    101122      IF(PRESENT(name)) THEN 
    … …  
    114135      ELSE 
    115136        field(ind)%ndim=2 
    116       ENDIF 
    117      
     137      END IF 
    118138     
    119139      field(ind)%data_type=data_type 
    120140      field(ind)%field_type=field_type 
    121        
    122       SELECT CASE(grid_type) 
    123          CASE(grid_ico) 
    124             ij_size=domain(ind)%iim 
    125             IF (field_type==field_T) THEN  
    126                ij_size=ij_size*domain(ind)%jjm 
    127             ELSE IF (field_type==field_U) THEN  
    128                ij_size=3*ij_size*domain(ind)%jjm 
    129             ELSE IF (field_type==field_Z) THEN  
    130                ij_size=2*ij_size*domain(ind)%jjm 
    131             ENDIF      
    132          
    133             IF (field(ind)%ndim==4) THEN 
    134                IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ij_size,dim1,dim2)) 
    135                IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ij_size,dim1,dim2)) 
    136                IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ij_size,dim1,dim2)) 
    137             ELSE IF (field(ind)%ndim==3) THEN 
    138                IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ij_size,dim1)) 
    139                IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ij_size,dim1)) 
    140                IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ij_size,dim1)) 
    141             ELSE IF (field(ind)%ndim==2) THEN 
    142                IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ij_size)) 
    143                IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ij_size)) 
    144                IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ij_size)) 
    145             ENDIF 
    146  
    147          CASE(grid_unst) 
    148             PRINT *, 'Allocating field ', field(ind)%name 
    149             IF (field_type==field_T) THEN  
    150                ij_size=primal_num 
    151             ELSE IF (field_type==field_U) THEN  
    152                ij_size=edge_num 
    153             ELSE IF (field_type==field_Z) THEN  
    154                ij_size=dual_num 
    155             ENDIF      
    156  
    157             IF (field(ind)%ndim==4) THEN 
    158                IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(dim1,ij_size,dim2)) 
    159                IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(dim1,ij_size,dim2)) 
    160                IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(dim1,ij_size,dim2)) 
    161             ELSE IF (field(ind)%ndim==3) THEN 
    162                IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(dim1,ij_size)) 
    163                IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(dim1,ij_size)) 
    164                IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(dim1,ij_size)) 
    165             ELSE IF (field(ind)%ndim==2) THEN 
    166                IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ij_size)) 
    167                IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ij_size)) 
    168                IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ij_size)) 
    169             ENDIF 
    170  
    171          END SELECT 
    172       ENDDO 
    173 !$OMP BARRIER 
     141 
     142      CALL allocate_field_XvalY(field(ind), dom(ind)) 
     143     END DO 
    174144    
    175145 END SUBROUTINE allocate_field_ 
    176146 
    177   SUBROUTINE allocate_field_glo(field,field_type,data_type,dim1,dim2,name) 
    178   USE domain_mod 
    179   IMPLICIT NONE 
    180     TYPE(t_field),POINTER :: field(:) 
    181     INTEGER,INTENT(IN) :: field_type 
    182     INTEGER,INTENT(IN) :: data_type 
    183     INTEGER,OPTIONAL :: dim1,dim2 
    184     CHARACTER(*), OPTIONAL :: name 
    185     INTEGER :: ind 
    186     INTEGER :: ii_size,jj_size 
    187  
    188     ALLOCATE(field(ndomain_glo))     
    189  
    190     DO ind=1,ndomain_glo 
    191    
    192       IF (PRESENT(dim2)) THEN 
    193         field(ind)%ndim=4  
    194         field(ind)%dim4=dim2  
    195         field(ind)%dim3=dim1  
    196       ELSE IF (PRESENT(dim1)) THEN 
    197         field(ind)%ndim=3 
    198         field(ind)%dim3=dim1  
    199       ELSE 
    200         field(ind)%ndim=2 
    201       ENDIF 
    202      
    203       IF(PRESENT(name)) THEN 
    204          field(ind)%name = name 
    205       ELSE 
    206          field(ind)%name = '(undefined)' 
    207       END IF 
    208      
    209       field(ind)%data_type=data_type 
    210       field(ind)%field_type=field_type 
    211      
    212       IF (field_type==field_T) THEN  
    213         jj_size=domain_glo(ind)%jjm 
    214       ELSE IF (field_type==field_U) THEN  
    215         jj_size=3*domain_glo(ind)%jjm 
    216       ELSE IF (field_type==field_Z) THEN  
    217         jj_size=2*domain_glo(ind)%jjm 
    218       ENDIF 
    219        
    220       ii_size=domain_glo(ind)%iim 
    221          
    222       IF (field(ind)%ndim==4) THEN 
    223         IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2)) 
    224         IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2)) 
    225         IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2)) 
    226       ELSE IF (field(ind)%ndim==3) THEN 
    227         IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1)) 
    228         IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1)) 
    229         IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1)) 
    230       ELSE IF (field(ind)%ndim==2) THEN 
    231         IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size)) 
    232         IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size)) 
    233         IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size)) 
    234       ENDIF 
    235        
    236    ENDDO 
    237    
    238   END SUBROUTINE allocate_field_glo 
     147  SUBROUTINE allocate_field_XvalY(field, dom) 
     148    USE domain_mod, ONLY : t_domain 
     149    USE grid_param 
     150    TYPE(t_field) :: field 
     151    TYPE(t_domain), INTENT(IN) :: dom 
     152    INTEGER :: data_type, dim1, dim2, ij_size 
     153    data_type = field%data_type 
     154    dim1      = field%dim3 
     155    dim2      = field%dim4 
     156    SELECT CASE(grid_type) 
     157    CASE(grid_ico) 
     158       ij_size=dom%iim 
     159       SELECT CASE(field%field_type) 
     160       CASE(field_T) 
     161          ij_size=ij_size*dom%jjm 
     162       CASE(field_U) 
     163          ij_size=3*ij_size*dom%jjm 
     164       CASE(field_Z) 
     165          ij_size=2*ij_size*dom%jjm 
     166       END SELECT 
     167        
     168       IF (field%ndim==4) THEN 
     169          IF (data_type==type_integer) ALLOCATE(field%ival4d(ij_size,dim1,dim2)) 
     170          IF (data_type==type_real)    ALLOCATE(field%rval4d(ij_size,dim1,dim2)) 
     171          IF (data_type==type_logical) ALLOCATE(field%lval4d(ij_size,dim1,dim2)) 
     172       ELSE IF (field%ndim==3) THEN 
     173          IF (data_type==type_integer) ALLOCATE(field%ival3d(ij_size,dim1)) 
     174          IF (data_type==type_real)    ALLOCATE(field%rval3d(ij_size,dim1)) 
     175          IF (data_type==type_logical) ALLOCATE(field%lval3d(ij_size,dim1)) 
     176       ELSE IF (field%ndim==2) THEN 
     177          IF (data_type==type_integer) ALLOCATE(field%ival2d(ij_size)) 
     178          IF (data_type==type_real)    ALLOCATE(field%rval2d(ij_size)) 
     179          IF (data_type==type_logical) ALLOCATE(field%lval2d(ij_size)) 
     180       ENDIF 
     181        
     182    CASE(grid_unst) 
     183       PRINT *, 'Allocating field ', field%name 
     184       SELECT CASE(field%field_type) 
     185       CASE(field_T) 
     186          ij_size=primal_num 
     187       CASE(field_U) 
     188          ij_size=edge_num 
     189       CASE(field_Z) 
     190          ij_size=dual_num 
     191       END SELECT 
     192 
     193       PRINT *, 'Allocating field ', field%name 
     194       PRINT *, '          with ij_size = ', ij_size 
     195        
     196       IF (field%ndim==4) THEN 
     197          IF (data_type==type_integer) ALLOCATE(field%ival4d(dim1,ij_size,dim2)) 
     198          IF (data_type==type_real)    ALLOCATE(field%rval4d(dim1,ij_size,dim2)) 
     199          IF (data_type==type_logical) ALLOCATE(field%lval4d(dim1,ij_size,dim2)) 
     200       ELSE IF (field%ndim==3) THEN 
     201          IF (data_type==type_integer) ALLOCATE(field%ival3d(dim1,ij_size)) 
     202          IF (data_type==type_real)    ALLOCATE(field%rval3d(dim1,ij_size)) 
     203          IF (data_type==type_logical) ALLOCATE(field%lval3d(dim1,ij_size)) 
     204       ELSE IF (field%ndim==2) THEN 
     205          IF (data_type==type_integer) ALLOCATE(field%ival2d(ij_size)) 
     206          IF (data_type==type_real)    ALLOCATE(field%rval2d(ij_size)) 
     207          IF (data_type==type_logical) ALLOCATE(field%lval2d(ij_size)) 
     208       ENDIF 
     209        
     210    END SELECT 
     211  END SUBROUTINE allocate_field_XvalY 
    239212 
    240213  SUBROUTINE deallocate_field(field) 
    … …  
    244217    TYPE(t_field),POINTER :: field(:) 
    245218    !$OMP BARRIER 
    246     CALL deallocate_field_(field) 
     219    CALL deallocate_field_(assigned_domain, field) 
    247220    !$OMP BARRIER 
    248221    !$OMP MASTER 
    … …  
    260233    !$OMP BARRIER 
    261234    DO i=1,SIZE(field,2) 
    262        CALL deallocate_field_(field(:,i)) 
     235       CALL deallocate_field_(assigned_domain, field(:,i)) 
    263236    END DO 
    264237    !$OMP BARRIER 
    … …  
    269242  END SUBROUTINE deallocate_fields 
    270243 
    271   SUBROUTINE deallocate_field_(field) 
    272   USE domain_mod 
     244  SUBROUTINE deallocate_field_(assigned_dom, field) 
    273245  USE omp_para 
    274   IMPLICIT NONE 
     246    IMPLICIT NONE 
     247    LOGICAL, INTENT(IN) :: assigned_dom(:) 
    275248    TYPE(t_field) :: field(:) 
    276249    INTEGER :: data_type 
    277250    INTEGER :: ind 
    278     DO ind=1,ndomain 
    279       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
     251    DO ind=1,SIZE(field) 
     252      IF (.NOT. assigned_dom(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
    280253 
    281254      data_type=field(ind)%data_type 
    … …  
    304277    INTEGER :: data_type 
    305278    INTEGER :: ind 
    306  
    307     DO ind=1,ndomain_glo 
    308  
    309       data_type=field(ind)%data_type 
    310          
    311       IF (field(ind)%ndim==4) THEN 
    312         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d) 
    313         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d) 
    314         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d) 
    315       ELSE IF (field(ind)%ndim==3) THEN 
    316         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d) 
    317         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d) 
    318         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d) 
    319       ELSE IF (field(ind)%ndim==2) THEN 
    320         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d) 
    321         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d) 
    322         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d) 
    323       ENDIF 
    324        
    325    ENDDO 
    326    DEALLOCATE(field) 
    327         
     279    LOGICAL :: assigned_dom(ndomain_glo) 
     280    ! ONLY the master thread is allowed to call this routine 
     281    CALL deallocate_field_(assigned_dom, field) 
     282    DEALLOCATE(field)        
    328283  END SUBROUTINE deallocate_field_glo 
    329284     
Note: See TracChangeset for help on using the changeset viewer.