Ignore:
Timestamp:
07/15/19 12:29:31 (5 years ago)
Author:
adurocher
Message:

trunk : GPU implementation with OpenACC ( merge from glcp.idris.fr )

Location:
codes/icosagcm/trunk/src/base
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • codes/icosagcm/trunk/src/base/abort.F90

    r901 r953  
    1717    !$omp end single 
    1818  end subroutine 
     19 
     20  !!!Abort execution when openacc is on 
     21  subroutine abort_acc( message ) 
     22    use mpi_mod 
     23    implicit none 
     24    character(len=*), optional, intent(in) :: message   
     25#ifdef _OPENACC 
     26    call dynamico_abort( "Not tested with OpenACC ! " // message ) 
     27#endif 
     28  end subroutine 
    1929end module 

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

    r548 r953  
    1313  TYPE t_field 
    1414    CHARACTER(30)      :: name 
    15     REAL(rstd),POINTER :: rval2d(:) 
    16     REAL(rstd),POINTER :: rval3d(:,:) 
    17     REAL(rstd),POINTER :: rval4d(:,:,:) 
     15    REAL(rstd),POINTER :: rval2d(:) => null() 
     16    REAL(rstd),POINTER :: rval3d(:,:) => null() 
     17    REAL(rstd),POINTER :: rval4d(:,:,:) => null() 
    1818 
    1919    INTEGER,POINTER :: ival2d(:) 
    … …  
    3030    INTEGER :: dim3 
    3131    INTEGER :: dim4 
     32     
     33    LOGICAL :: ondevice !< flag if field is allocated on device as well 
    3234  END TYPE t_field    
    3335 
    … …  
    4850CONTAINS 
    4951 
    50   SUBROUTINE allocate_field(field,field_type,data_type,dim1,dim2,name) 
     52  SUBROUTINE allocate_field(field,field_type,data_type,dim1,dim2,name,ondevice) 
    5153  USE domain_mod 
    5254  USE omp_para 
    … …  
    5658    INTEGER,OPTIONAL :: dim1,dim2 
    5759    CHARACTER(*), OPTIONAL :: name 
     60    LOGICAL, INTENT(IN), OPTIONAL :: ondevice  
    5861!$OMP BARRIER 
    5962!$OMP MASTER 
    60     ALLOCATE(field(ndomain)) 
     63    ALLOCATE(field(ndomain))     
    6164!$OMP END MASTER 
    6265!$OMP BARRIER 
    63     CALL allocate_field_(field,field_type,data_type,dim1,dim2,name) 
     66 
     67    CALL allocate_field_(field,field_type,data_type,dim1,dim2,name,ondevice) 
     68     
    6469  END SUBROUTINE allocate_field 
    6570 
    66   SUBROUTINE allocate_fields(nfield,field,field_type,data_type,dim1,dim2,name) 
     71  SUBROUTINE allocate_fields(nfield,field,field_type,data_type,dim1,dim2,name, ondevice) 
    6772  USE domain_mod 
    6873  USE omp_para 
    … …  
    7378    INTEGER,OPTIONAL :: dim1,dim2 
    7479    CHARACTER(*), OPTIONAL :: name 
     80    LOGICAL, INTENT(IN), OPTIONAL :: ondevice 
    7581    INTEGER :: i 
    7682!$OMP BARRIER 
    … …  
    8086!$OMP BARRIER 
    8187    DO i=1,nfield 
    82        CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name) 
     88       CALL allocate_field_(field(:,i),field_type,data_type,dim1,dim2,name,ondevice) 
    8389    END DO 
    8490  END SUBROUTINE allocate_fields 
    8591 
    86   SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name) 
     92  SUBROUTINE allocate_field_(field,field_type,data_type,dim1,dim2,name,ondevice) 
    8793  USE domain_mod 
    8894  USE omp_para 
    … …  
    9399    INTEGER,OPTIONAL :: dim1,dim2 
    94100    CHARACTER(*), OPTIONAL :: name 
     101    LOGICAL, INTENT(IN), OPTIONAL :: ondevice 
    95102    INTEGER :: ind 
    96103    INTEGER :: ii_size,jj_size 
    … …  
    119126      field(ind)%data_type=data_type 
    120127      field(ind)%field_type=field_type 
    121      
     128 
    122129      IF (field_type==field_T) THEN  
    123130        jj_size=domain(ind)%jjm 
    … …  
    131138         
    132139      IF (field(ind)%ndim==4) THEN 
    133         IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2)) 
    134         IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2)) 
    135         IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2)) 
     140         IF (data_type==type_integer) ALLOCATE(field(ind)%ival4d(ii_size*jj_size,dim1,dim2)) 
     141         IF (data_type==type_real)    ALLOCATE(field(ind)%rval4d(ii_size*jj_size,dim1,dim2)) 
     142         IF (data_type==type_logical) ALLOCATE(field(ind)%lval4d(ii_size*jj_size,dim1,dim2)) 
     143 
    136144      ELSE IF (field(ind)%ndim==3) THEN 
    137         IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1)) 
    138         IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1)) 
    139         IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1)) 
     145         IF (data_type==type_integer) ALLOCATE(field(ind)%ival3d(ii_size*jj_size,dim1)) 
     146         IF (data_type==type_real)    ALLOCATE(field(ind)%rval3d(ii_size*jj_size,dim1)) 
     147         IF (data_type==type_logical) ALLOCATE(field(ind)%lval3d(ii_size*jj_size,dim1)) 
     148 
    140149      ELSE IF (field(ind)%ndim==2) THEN 
    141         IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size)) 
    142         IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size)) 
    143         IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size)) 
    144       ENDIF 
    145        
     150         IF (data_type==type_integer) ALLOCATE(field(ind)%ival2d(ii_size*jj_size)) 
     151         IF (data_type==type_real)    ALLOCATE(field(ind)%rval2d(ii_size*jj_size)) 
     152         IF (data_type==type_logical) ALLOCATE(field(ind)%lval2d(ii_size*jj_size)) 
     153 
     154      ENDIF 
     155 
     156      field(ind)%ondevice = .FALSE. 
     157      IF (PRESENT(ondevice)) THEN 
     158         IF (ondevice) CALL create_device_field(field(ind)) 
     159      END IF 
     160    
    146161   ENDDO 
    147162!$OMP BARRIER 
    … …  
    160175    INTEGER :: ii_size,jj_size 
    161176 
    162     ALLOCATE(field(ndomain_glo))     
     177    ALLOCATE(field(ndomain_glo))  
    163178 
    164179    DO ind=1,ndomain_glo 
    … …  
    184199      field(ind)%field_type=field_type 
    185200     
     201      field(ind)%ondevice = .FALSE. 
     202 
    186203      IF (field_type==field_T) THEN  
    187204        jj_size=domain_glo(ind)%jjm 
    … …  
    251268    INTEGER :: ind 
    252269    DO ind=1,ndomain 
    253       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
    254  
    255       data_type=field(ind)%data_type 
    256          
    257       IF (field(ind)%ndim==4) THEN 
    258         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival4d) 
    259         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval4d) 
    260         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval4d) 
    261       ELSE IF (field(ind)%ndim==3) THEN 
    262         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival3d) 
    263         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval3d) 
    264         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval3d) 
    265       ELSE IF (field(ind)%ndim==2) THEN 
    266         IF (data_type==type_integer) DEALLOCATE(field(ind)%ival2d) 
    267         IF (data_type==type_real)    DEALLOCATE(field(ind)%rval2d) 
    268         IF (data_type==type_logical) DEALLOCATE(field(ind)%lval2d) 
    269       ENDIF 
    270        
    271    ENDDO 
     270       IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
     271 
     272       data_type=field(ind)%data_type 
     273 
     274       IF (field(ind)%ndim==4) THEN 
     275          IF (data_type==type_integer) THEN 
     276             DEALLOCATE(field(ind)%ival4d) 
     277             IF (field(ind)%ondevice) THEN 
     278                !$acc exit data delete(field(ind)%ival4d) 
     279                CONTINUE 
     280             END IF 
     281          END IF 
     282 
     283          IF (data_type==type_real) THEN 
     284             DEALLOCATE(field(ind)%rval4d) 
     285             IF (field(ind)%ondevice) THEN 
     286                !$acc exit data delete(field(ind)%rval4d) 
     287                CONTINUE 
     288             END IF 
     289          END IF 
     290 
     291          IF (data_type==type_logical) THEN 
     292             DEALLOCATE(field(ind)%lval4d) 
     293             IF (field(ind)%ondevice) THEN 
     294                !$acc exit data delete(field(ind)%lval4d) 
     295                CONTINUE 
     296             END IF 
     297          END IF 
     298 
     299       ELSE IF (field(ind)%ndim==3) THEN 
     300          IF (data_type==type_integer) THEN 
     301             DEALLOCATE(field(ind)%ival3d) 
     302             IF (field(ind)%ondevice) THEN 
     303                !$acc exit data delete(field(ind)%ival3d) 
     304                CONTINUE 
     305             END IF 
     306          END IF 
     307 
     308          IF (data_type==type_real) THEN 
     309             DEALLOCATE(field(ind)%rval3d) 
     310             IF (field(ind)%ondevice) THEN 
     311                !$acc exit data delete(field(ind)%rval3d) 
     312                CONTINUE 
     313             END IF 
     314          END IF 
     315 
     316          IF (data_type==type_logical) THEN 
     317             DEALLOCATE(field(ind)%lval3d) 
     318             IF (field(ind)%ondevice) THEN 
     319                !$acc exit data delete(field(ind)%lval3d) 
     320                CONTINUE 
     321             END IF 
     322          END IF 
     323 
     324       ELSE IF (field(ind)%ndim==2) THEN 
     325          IF (data_type==type_integer) THEN 
     326             DEALLOCATE(field(ind)%ival2d) 
     327             IF (field(ind)%ondevice) THEN 
     328                !$acc exit data delete(field(ind)%ival2d) 
     329                CONTINUE 
     330             END IF 
     331          END IF 
     332 
     333          IF (data_type==type_real) THEN 
     334             DEALLOCATE(field(ind)%rval2d) 
     335             IF (field(ind)%ondevice) THEN 
     336                !$acc exit data delete(field(ind)%rval2d) 
     337                CONTINUE 
     338             END IF 
     339          END IF 
     340 
     341          IF (data_type==type_logical) THEN 
     342             DEALLOCATE(field(ind)%lval2d) 
     343             IF (field(ind)%ondevice) THEN 
     344                !$acc exit data delete(field(ind)%lval2d) 
     345                CONTINUE 
     346             END IF 
     347          END IF 
     348 
     349       ENDIF 
     350 
     351    ENDDO 
    272352  END SUBROUTINE deallocate_field_ 
    273353 
    … …  
    460540  END SUBROUTINE  getval_l4d     
    461541 
     542 
     543  SUBROUTINE update_device_field(field) 
     544  USE domain_mod 
     545  USE omp_para 
     546  IMPLICIT NONE 
     547    TYPE(t_field) :: field(:) 
     548    INTEGER :: ind 
     549 
     550    DO ind=1,ndomain 
     551      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
     552 
     553      IF (.NOT. field(ind)%ondevice) CALL create_device_field(field(ind)) 
     554 
     555      IF (field(ind)%ndim==4) THEN 
     556         IF (field(ind)%data_type==type_integer) THEN 
     557            !$acc update device(field(ind)%ival4d(:,:,:)) 
     558            CONTINUE 
     559         END IF 
     560 
     561         IF (field(ind)%data_type==type_real) THEN 
     562            !$acc update device(field(ind)%rval4d(:,:,:)) 
     563            CONTINUE 
     564         END IF 
     565 
     566         IF (field(ind)%data_type==type_logical) THEN 
     567            !$acc update device(field(ind)%lval4d(:,:,:)) 
     568            CONTINUE 
     569         END IF 
     570 
     571      ELSE IF (field(ind)%ndim==3) THEN 
     572         IF (field(ind)%data_type==type_integer) THEN 
     573            !$acc update device(field(ind)%ival3d(:,:)) 
     574            CONTINUE 
     575         END IF 
     576 
     577         IF (field(ind)%data_type==type_real) THEN 
     578            !$acc update device(field(ind)%rval3d(:,:)) 
     579            CONTINUE 
     580         END IF 
     581 
     582         IF (field(ind)%data_type==type_logical) THEN 
     583            !$acc update device(field(ind)%lval3d(:,:)) 
     584            CONTINUE 
     585         END IF 
     586 
     587      ELSE IF (field(ind)%ndim==2) THEN 
     588         IF (field(ind)%data_type==type_integer) THEN 
     589            !$acc update device(field(ind)%ival2d(:)) 
     590            CONTINUE 
     591         END IF 
     592 
     593         IF (field(ind)%data_type==type_real) THEN 
     594            !$acc update device(field(ind)%rval2d(:)) 
     595            CONTINUE 
     596         END IF 
     597 
     598         IF (field(ind)%data_type==type_logical) THEN 
     599            !$acc update device(field(ind)%lval2d(:)) 
     600            CONTINUE 
     601         END IF 
     602      ENDIF 
     603   ENDDO 
     604   !$OMP BARRIER 
     605 END SUBROUTINE update_device_field 
     606  
     607  SUBROUTINE update_host_field(field) 
     608  USE domain_mod 
     609  USE omp_para 
     610  IMPLICIT NONE 
     611    TYPE(t_field) :: field(:) 
     612    INTEGER :: ind 
     613 
     614    DO ind=1,ndomain 
     615      IF (.NOT. assigned_domain(ind)  .OR. .NOT. is_omp_level_master) CYCLE 
     616 
     617      IF (field(ind)%ondevice) THEN 
     618         
     619         IF (field(ind)%ndim==4) THEN 
     620            IF (field(ind)%data_type==type_integer) THEN 
     621               !$acc update host(field(ind)%ival4d(:,:,:)) wait 
     622               CONTINUE 
     623            END IF 
     624 
     625            IF (field(ind)%data_type==type_real) THEN 
     626               !$acc update host(field(ind)%rval4d(:,:,:)) wait 
     627               CONTINUE 
     628            END IF 
     629 
     630            IF (field(ind)%data_type==type_logical) THEN 
     631               !$acc update host(field(ind)%lval4d(:,:,:)) wait 
     632               CONTINUE 
     633            END IF 
     634          
     635         ELSE IF (field(ind)%ndim==3) THEN 
     636            IF (field(ind)%data_type==type_integer) THEN 
     637               !$acc update host(field(ind)%ival3d(:,:)) wait 
     638               CONTINUE 
     639            END IF 
     640 
     641            IF (field(ind)%data_type==type_real) THEN 
     642               !$acc update host(field(ind)%rval3d(:,:)) wait 
     643               CONTINUE 
     644            END IF 
     645 
     646            IF (field(ind)%data_type==type_logical) THEN 
     647               !$acc update host(field(ind)%lval3d(:,:)) wait 
     648               CONTINUE 
     649            END IF 
     650 
     651         ELSE IF (field(ind)%ndim==2) THEN 
     652            IF (field(ind)%data_type==type_integer) THEN 
     653               !$acc update host(field(ind)%ival2d(:)) wait 
     654               CONTINUE 
     655            END IF 
     656 
     657            IF (field(ind)%data_type==type_real) THEN 
     658               !$acc update host(field(ind)%rval2d(:)) wait 
     659               CONTINUE 
     660            END IF 
     661 
     662            IF (field(ind)%data_type==type_logical) THEN 
     663               !$acc update host(field(ind)%lval2d(:)) wait 
     664               CONTINUE 
     665            END IF 
     666         ENDIF 
     667      END IF 
     668   ENDDO 
     669   !$OMP BARRIER 
     670 END SUBROUTINE update_host_field 
     671 
     672 SUBROUTINE create_device_field(field) 
     673    TYPE(t_field) :: field 
     674 
     675    IF (field%ondevice) THEN 
     676       PRINT *, "Field is already on device !" 
     677       STOP 1 
     678    END IF 
     679    IF (field%ndim==4) THEN 
     680       IF (field%data_type==type_integer) THEN 
     681          !$acc enter data create(field%ival4d(:,:,:)) 
     682       END IF 
     683 
     684       IF (field%data_type==type_real) THEN 
     685          !$acc enter data create(field%rval4d(:,:,:)) 
     686       END IF 
     687 
     688       IF (field%data_type==type_logical) THEN 
     689          !$acc enter data create(field%lval4d(:,:,:)) 
     690       END IF 
     691 
     692    ELSE IF (field%ndim==3) THEN 
     693       IF (field%data_type==type_integer) THEN 
     694          !$acc enter data create(field%ival3d(:,:)) 
     695       END IF 
     696 
     697       IF (field%data_type==type_real) THEN 
     698          !$acc enter data create(field%rval3d(:,:)) 
     699       END IF 
     700 
     701       IF (field%data_type==type_logical) THEN 
     702          !$acc enter data create(field%lval3d(:,:)) 
     703       END IF 
     704 
     705    ELSE IF (field%ndim==2) THEN 
     706       IF (field%data_type==type_integer) THEN 
     707          !$acc enter data create(field%ival2d(:)) 
     708       END IF 
     709 
     710       IF (field%data_type==type_real) THEN 
     711          !$acc enter data create(field%rval2d(:)) 
     712       END IF 
     713 
     714       IF (field%data_type==type_logical) THEN 
     715          !$acc enter data create(field%lval2d(:)) 
     716       END IF 
     717    ENDIF 
     718    field%ondevice = .TRUE. 
     719  END SUBROUTINE create_device_field 
     720  
    462721END MODULE field_mod    
Note: See TracChangeset for help on using the changeset viewer.