Changeset 862 for codes/icosagcm/devel/src
- Timestamp:
- 05/09/19 01:29:34 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/base/field.f90
r839 r862 44 44 END INTERFACE 45 45 46 PRIVATE :: allocate_field_ 46 PRIVATE :: allocate_field_, deallocate_field_ 47 47 48 48 CONTAINS … … 61 61 !$OMP END MASTER 62 62 !$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 64 65 END SUBROUTINE allocate_field 65 66 … … 80 81 !$OMP BARRIER 81 82 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) 83 84 END DO 85 !$OMP BARRIER 84 86 END SUBROUTINE allocate_fields 85 87 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) 87 108 USE domain_mod 88 109 USE omp_para 89 USE grid_param 110 TYPE(t_domain), INTENT(IN) :: dom(:) 111 LOGICAL, INTENT(IN) :: assigned_dom(:) 90 112 TYPE(t_field) :: field(:) 91 113 INTEGER,INTENT(IN) :: field_type … … 94 116 CHARACTER(*), OPTIONAL :: name 95 117 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 100 121 101 122 IF(PRESENT(name)) THEN … … 114 135 ELSE 115 136 field(ind)%ndim=2 116 ENDIF 117 137 END IF 118 138 119 139 field(ind)%data_type=data_type 120 140 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 174 144 175 145 END SUBROUTINE allocate_field_ 176 146 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 239 212 240 213 SUBROUTINE deallocate_field(field) … … 244 217 TYPE(t_field),POINTER :: field(:) 245 218 !$OMP BARRIER 246 CALL deallocate_field_( field)219 CALL deallocate_field_(assigned_domain, field) 247 220 !$OMP BARRIER 248 221 !$OMP MASTER … … 260 233 !$OMP BARRIER 261 234 DO i=1,SIZE(field,2) 262 CALL deallocate_field_( field(:,i))235 CALL deallocate_field_(assigned_domain, field(:,i)) 263 236 END DO 264 237 !$OMP BARRIER … … 269 242 END SUBROUTINE deallocate_fields 270 243 271 SUBROUTINE deallocate_field_(field) 272 USE domain_mod 244 SUBROUTINE deallocate_field_(assigned_dom, field) 273 245 USE omp_para 274 IMPLICIT NONE 246 IMPLICIT NONE 247 LOGICAL, INTENT(IN) :: assigned_dom(:) 275 248 TYPE(t_field) :: field(:) 276 249 INTEGER :: data_type 277 250 INTEGER :: ind 278 DO ind=1, ndomain279 IF (.NOT. assigned_dom ain(ind) .OR. .NOT. is_omp_level_master) CYCLE251 DO ind=1,SIZE(field) 252 IF (.NOT. assigned_dom(ind) .OR. .NOT. is_omp_level_master) CYCLE 280 253 281 254 data_type=field(ind)%data_type … … 304 277 INTEGER :: data_type 305 278 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) 328 283 END SUBROUTINE deallocate_field_glo 329 284
Note: See TracChangeset
for help on using the changeset viewer.