source: codes/icosagcm/trunk/src/icosa_gcm.f90 @ 280

PROGRAM ICOSA_GCM
  USE icosa
  USE timeloop_gcm_mod
  USE disvert_mod
  USE etat0_mod
  USE wind_mod
  USE mpipara
  USE omp_para
  USE vertical_interp_mod
  USE trace
  USE output_field_mod
  USE xios_mod
  USE write_field
!  USE getin_mod
  IMPLICIT NONE
  
  CALL init_mpipara
  CALL trace_off
  CALL xios_init
  CALL init_earth_const 
  CALL init_grid_param(is_mpi_root)
  CALL init_omp_para
  CALL compute_metric
  CALL compute_domain
  CALL init_transfert
  CALL init_writefield
  CALL init_trace

!$OMP PARALLEL  
  CALL compute_geometry
  CALL check_total_area
  
  CALL init_disvert 
  CALL init_vertical_interp

  CALL WriteField("Ai",geom%Ai)
  
  IF (is_mpi_root) CALL write_apbp
  CALL init_time

  CALL output_field_init
  CALL init_timeloop
  
  CALL timeloop

!$OMP END PARALLEL

  CALL output_field_finalize
  CALL close_files
  CALL close_time_counter
  CALL finalize_mpipara

CONTAINS
  
  SUBROUTINE check_total_area
    IMPLICIT NONE
    TYPE(t_field),POINTER,SAVE :: sum_ne(:)
    TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)
    REAL(rstd),POINTER :: pt_sum_ne(:)
    
    INTEGER :: ind,i,j,k,n
    REAL(rstd) :: vect(3,6)
    REAL(rstd) :: centr(3),dist    
    REAL(rstd) :: tot_sum=0
    CALL allocate_field(sum_ne,field_T,type_real)
    
    !$OMP BARRIER
    !$OMP MASTER
    DO ind=1,ndomain
       
       pt_sum_ne=sum_ne(ind)
       
       CALL swap_dimensions(ind)
       CALL swap_geometry(ind)
       
       DO j=jj_begin,jj_end
          DO i=ii_begin,ii_end
             n=(j-1)*iim+i
             pt_sum_ne(n)=0
             DO k=1,6
                pt_sum_ne(n)=pt_sum_ne(n)+ne(n,k)
             ENDDO
             IF (domain(ind)%own(i,j)) tot_sum=tot_sum+Ai(n)
          ENDDO
       ENDDO
    ENDDO
    
    IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
    !$OMP END MASTER
    
  END SUBROUTINE check_total_area
END PROGRAM ICOSA_gcm