Changeset 164 for palm


Ignore:
Timestamp:
May 15, 2008 8:46:15 AM (16 years ago)
Author:
raasch
Message:

optimization of transpositions for 2D decompositions, workaround for using -env option with mpiexec, adjustments for lcxt4

Location:
palm/trunk
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SCRIPTS/mrun

    r149 r164  
    140140     #                     true, mrun tries "ln -f" on local output and resorts
    141141     #                     to "cp" or "cp -r" on error
     142     # 15/04/08 - Siggi  - argument -c introduced to most of the subjob calls,
     143     #                     which allows the user to choose his own job catalog
     144     #                     by setting job_catalog in the configuration file
     145     #                     (default is ~/job_queue),
     146     #                     workaround for mpixec with -env option,
     147     #                     adjustments for lcxt4 (Bergen Center for Computational
     148     #                     Science)
    142149 
    143150    # VARIABLENVEREINBARUNGEN + DEFAULTWERTE
     
    183190 input_list=""
    184191 interpreted_config_file=""
     192 job_catalog="~/job_queue"
    185193 job_on_file=""
    186194 keep_data_from_previous_run=false
     
    18171825 lopts="$lopts $netcdf_lib $dvrp_lib"
    18181826 ROPTS="$ropts"
    1819  if [[ ( $(echo $host | cut -c1-3) = nec  ||  $(echo $host | cut -c1-3) = ibm  ||  $host = lctit  ||  $host = lcfimm )  &&  -n $numprocs ]]
     1827 if [[ ( $(echo $host | cut -c1-3) = nec  ||  $(echo $host | cut -c1-3) = ibm  ||  $host = lctit  ||  $host = lcfimm  ||  $host = lcxt4 )  &&  -n $numprocs ]]
    18201828 then
    18211829    XOPT="-X $numprocs"
     
    27682776             then
    27692777                printf "\n\n"
    2770                 mpiexec  -machinefile hostfile  -n $ii  a.out  $ROPTS
     2778                if [[ $host = lcxt4 ]]
     2779                then
     2780                   aprun  -n $ii  -N $tasks_per_node  a.out  $ROPTS
     2781                else
     2782                   mpiexec  -machinefile hostfile  -n $ii  a.out  $ROPTS
     2783                fi
    27712784             else
    27722785                ((  iii = ii / 2 ))
     2786                echo "atmosphere_to_ocean"  >  runfile_atmos
     2787                echo "ocean_to_atmosphere"  >  runfile_ocean
     2788
    27732789                printf "\n      coupled run ($iii atmosphere, $iii ocean)"
    27742790                printf "\n\n"
    2775                 mpiexec  -machinefile hostfile  -n $iii  -env coupling_mode atmosphere_to_ocean  a.out  $ROPTS  &
    2776                 mpiexec  -machinefile hostfile  -n $iii  -env coupling_mode ocean_to_atmosphere  a.out  $ROPTS  &
     2791
     2792                if [[ $host == lcxt4 ]]
     2793                then
     2794                   aprun  -n $iii  -N $tasks_per_node  a.out < runfile_atmos  $ROPTS  &
     2795                   aprun  -n $iii  -N $tasks_per_node  a.out < runfile_ocean  $ROPTS  &
     2796                else
     2797
     2798                      # WORKAROUND BECAUSE mpiexec WITH -env option IS NOT AVAILABLE ON SOME SYSTEMS
     2799                   mpiexec  -machinefile hostfile  -n $iii  a.out  $ROPTS  <  runfile_atmos &
     2800                   mpiexec  -machinefile hostfile  -n $iii  a.out  $ROPTS  <  runfile_ocean &
     2801#                   mpiexec  -machinefile hostfile  -n $iii  -env coupling_mode atmosphere_to_ocean  a.out  $ROPTS  &
     2802#                   mpiexec  -machinefile hostfile  -n $iii  -env coupling_mode ocean_to_atmosphere  a.out  $ROPTS  &
     2803                fi
    27772804                wait
    27782805             fi
     
    29702997                      if [[ "$LOGNAME" = b323013 ]]
    29712998                      then
    2972                          subjob  -v  -q c1  -X 0  -m 1000  -t 900  transfer_${localout[$i]}
     2999                         subjob  -v  -q c1  -X 0  -m 1000  -t 900  -c $job_catalog  transfer_${localout[$i]}
    29733000                      else
    2974                          subjob  -d  -v  -q c1  -X 0  -m 1000  -t 900  transfer_${localout[$i]}
     3001                         subjob  -d  -v  -q c1  -X 0  -m 1000  -t 900  -c $job_catalog  transfer_${localout[$i]}
    29753002                      fi
    29763003                   fi
     
    30453072                      if [[ $LOGNAME = b323013 ]]
    30463073                      then
    3047                          subjob  -v  -q c1  -X 0  -m 1000  -t 900  transfer_${localout[$i]}
     3074                         subjob  -v  -q c1  -X 0  -m 1000  -t 900  -c $job_catalog  transfer_${localout[$i]}
    30483075                      else
    3049                          subjob  -d  -v  -q c1  -X 0  -m 1000  -t 900  transfer_${localout[$i]}
     3076                         subjob  -d  -v  -q c1  -X 0  -m 1000  -t 900  -c $job_catalog  transfer_${localout[$i]}
    30503077                      fi
    30513078                   fi
     
    32323259                   if [[ $localhost = ibmh  ||  $localhost = ibmb ]]
    32333260                   then
    3234 #                      subjob  -d  -v  -q cdata  -X 0  -m 1000  -t 43200  archive_${frelout[$i]}
    3235                       subjob   -v  -q cdata  -X 0  -m 1000  -t 43200  archive_${frelout[$i]}
     3261#                      subjob  -d  -v  -q cdata  -X 0  -m 1000  -t 43200  -c $job_catalog  archive_${frelout[$i]}
     3262                      subjob   -v  -q cdata  -X 0  -m 1000  -t 43200  -c $job_catalog  archive_${frelout[$i]}
    32363263                   elif [[ $localhost = nech ]]
    32373264                   then
     
    33573384                fi
    33583385
    3359                 subjob  -v  -d  -q cdata  -X 0  -m 1000  -t 43200  archive_${frelout[$i]}
     3386                subjob  -v  -d  -q cdata  -X 0  -m 1000  -t 43200  -c $job_catalog  archive_${frelout[$i]}
    33603387                printf "              Archiving of $tmp_data_catalog/${frelout[$i]} initiated (batch job submitted)\n"
    33613388                file_saved=true
     
    38003827    fi
    38013828
    3802     subjob  $job_on_file  -h $host  -u $remote_username -g $group_number -q $queue  -m $memory  -N $node_usage -t $cpumax  $XOPT  $TOPT  $OOPT  -n $fname  -v  $jobfile
     3829    subjob  $job_on_file  -h $host  -u $remote_username -g $group_number -q $queue  -m $memory  -N $node_usage -t $cpumax  $XOPT  $TOPT  $OOPT  -n $fname  -v  -c $job_catalog $jobfile
    38033830    rm -rf  $jobfile
    38043831
  • palm/trunk/SCRIPTS/subjob

    r129 r164  
    9090     # 19/10/07 - Siggi - a ";" was missing in the last change done by Marcus
    9191     # 30/10/07 - Marcus- further adjustments for queues on lctit
     92     # 15/05/08 - Siggi - adjustments for lcxt4 (Bergen Center for Computational
     93     #                    Science)
    9294
    9395
     
    167169     (gregale)               local_addres=130.75.105.109; local_host=lcmuk;;
    168170     (hababai)               local_addres=130.75.105.108; local_host=lcmuk;;
     171     (hexagon.bccs.uib.no)   local_addres=129.177.20.113; local_host=lcxt4;;
    169172     (hreg*-en0|hanni*-en0)  local_addres=130.75.4.10;    local_host=ibmh;;
    170173     (irifi)                 local_addres=130.75.105.104; local_host=lcmuk;;
    171174     (levanto)               local_addres=130.75.105.45;  local_host=lcmuk;;
    172175     (maestro)               local_addres=130.75.105.2;   local_host=lcmuk;;
     176     (nid*)                  local_addres=129.177.20.113; local_host=lcxt4;;
    173177     (nobel*)                local_addres=150.183.5.101;  local_host=ibms;;
    174178     (orkan)                 local_addres=130.75.105.3;   local_host=lcmuk;;
     
    303307        (lcfimm) remote_addres=172.20.4.2; submcom=/opt/torque/bin/qsub;;
    304308        (lctit)  queue=lctit; remote_addres=172.17.75.161; submcom=/n1ge/TITECH_GRID/tools/bin/n1ge;;
     309        (lcxt4)  remote_addres=129.177.20.113; submcom=/opt/torque/2.3.0/bin/qsub;;
    305310        (nech)   qsubmem=memsz_job; qsubtime=cputim_job; remote_addres=136.172.44.147; submcom="/usr/local/bin/qsub";;
    306311        (neck)   qsubmem=memsz_job; qsubtime=cputim_job; remote_addres=133.5.178.11; submcom="/usr/bin/nqsII/qsub";;
     
    639644%%END%%
    640645
     646 elif [[ $remote_host = lcxt4 ]]
     647 then
     648
     649    if [[ $numprocs != 0 ]]
     650    then
     651       cat > $job_to_send << %%END%%
     652#!/bin/ksh
     653#PBS -S /bin/ksh
     654#PBS -N $job_name
     655#PBS -A nersc
     656#PBS -l walltime=$timestring
     657#PBS -l mppwidth=${numprocs}
     658#PBS -l mppnppn=${tasks_per_node}
     659#PBS -m abe
     660#PBS -M igore@nersc.no
     661#PBS -o $remote_dayfile
     662#PBS -e $remote_dayfile
     663
     664%%END%%
     665
    641666    else
    642667       cat > $job_to_send << %%END%%
     
    10221047       then
    10231048          eval  $submcom  $job_on_remhost
    1024        elif [[ $local_host = lcfimm ]]
    1025        then
    1026           eval  $submcom  $job_on_remhost
    1027           echo "$submcom  $job_on_remhost"
    1028           chmod  u+x  $job_on_remhost
    1029        elif [[ $local_host = lctit ]]
     1049       elif [[  $local_host = lcfimm  ||  $local_host = lctit  ||  $localhost = lcxt4 ]]
    10301050       then
    10311051          eval  $submcom  $job_on_remhost
  • palm/trunk/SOURCE/CURRENT_MODIFICATIONS

    r158 r164  
    3030User-defined spectra.
    3131
     32Argument -c introduced to most of the subjob calls, which allows the user to
     33choose his own job catalog by setting job_catalog in the configuration file
     34(default is ~/job_queue). Workaround for mpixec with -env option.
     35Adjustments for lcxt4 (Bergen Center for Computational Science) (mrun, subjob)
     36
    3237advec_particles, calc_spectra, check_open, check_parameters, data_output_spectra, header, init_particles, init_pegrid, init_3d_model, modules, netcdf, parin, particle_boundary_conds, plant_canopy_model, prognostic_equations, read_var_list, read_3d_binary, time_integration, user_interface, write_var_list, write_3d_binary
    3338
     
    5863informations are now contained in file _0000. (parin, check_open)
    5964
    60 check_open, init_3d_model, modules, parin, read_var_list, read_3d_binary, write_var_list, write_3d_binary
     65Transpositions for the 2D domain decomposition have been optimized by using
     66f_inv as an automatic array instead of providing the memory by a dummy argument.
     67This spares one copy loop per transposition. Order of indices in the 3D loops
     68in some of the transpose routines have been rearranged for better cache utilization.
     69Both have been suggested by Roland Richter (SGI) as part of the
     70HLRN-II benchmark process. (transpose)
     71
     72Workaround for getting information about the coupling mode. (palm)
     73
     74advec_s_ups, advec_u_ups, advec_v_ups, advec_w_ups, calc_spectra, check_open, init_3d_model, modules, palm, parin, poisfft, read_var_list, read_3d_binary, transpose, write_var_list, write_3d_binary
    6175
    6276
  • palm/trunk/SOURCE/advec_s_ups.f90

    r4 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Arguments removed from transpose routines
    77!
    88! Former revisions:
     
    7575!
    7676!-- Transpose the component to be advected: z --> x
    77     CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
     77    CALL transpose_zx( v_ad, tend, v_ad )
    7878
    7979#else
     
    101101!
    102102!-- Transpose the advecting componnet: z --> x
    103     CALL transpose_zx( d, tend, d, tend, d )
     103    CALL transpose_zx( d, tend, d )
    104104
    105105#endif
     
    124124!
    125125!-- Transpose the advecting component: z --> y
    126     CALL transpose_zx( d, tend, d, tend, d )
    127     CALL transpose_xy( d, tend, d, tend, d )
     126    CALL transpose_zx( d, tend, d )
     127    CALL transpose_xy( d, tend, d )
    128128
    129129!
    130130!-- Transpose the component to be advected: x --> y
    131     CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
     131    CALL transpose_xy( v_ad, tend, v_ad )
    132132
    133133#endif
     
    155155!
    156156!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
    157     CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
    158     CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
     157    CALL transpose_yx( v_ad, tend, v_ad )
     158    CALL transpose_xz( v_ad, tend, v_ad )
    159159
    160160!
  • palm/trunk/SOURCE/advec_u_ups.f90

    r4 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Arguments removed from transpose routines
    77!
    88! Former revisions:
     
    6969!
    7070!-- Transpose the component to be advected: z --> x
    71     CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
     71    CALL transpose_zx( v_ad, tend, v_ad )
    7272
    7373!
     
    115115!
    116116!-- Transpose the advecting component: z --> y
    117     CALL transpose_zx( d, tend, d, tend, d )
    118     CALL transpose_xy( d, tend, d, tend, d )
     117    CALL transpose_zx( d, tend, d )
     118    CALL transpose_xy( d, tend, d )
    119119
    120120!
    121121!-- Transpose the component to be advected: x --> y
    122     CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
     122    CALL transpose_xy( v_ad, tend, v_ad )
    123123
    124124#endif
     
    148148!
    149149!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
    150     CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
    151     CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
     150    CALL transpose_yx( v_ad, tend, v_ad )
     151    CALL transpose_xz( v_ad, tend, v_ad )
    152152
    153153!
  • palm/trunk/SOURCE/advec_v_ups.f90

    r4 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Arguments removed from transpose routines
    77!
    88! Former revisions:
     
    6969!
    7070!-- Transpose the component to be advected: z --> x
    71     CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
     71    CALL transpose_zx( v_ad, tend, v_ad )
    7272
    7373#else
     
    9797!
    9898!-- Transpose the advecting component: z --> x
    99     CALL transpose_zx( d, tend, d, tend, d )
     99    CALL transpose_zx( d, tend, d )
    100100
    101101#endif
     
    116116!
    117117!-- Transpose the advecting component: z --> y
    118     CALL transpose_zx( d, tend, d, tend, d )
    119     CALL transpose_xy( d, tend, d, tend, d )
     118    CALL transpose_zx( d, tend, d )
     119    CALL transpose_xy( d, tend, d )
    120120
    121121!
    122122!-- Transpose the component to be advected: x --> y
    123     CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
     123    CALL transpose_xy( v_ad, tend, v_ad )
    124124
    125125#endif
     
    149149!
    150150!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
    151     CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
    152     CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
     151    CALL transpose_yx( v_ad, tend, v_ad )
     152    CALL transpose_xz( v_ad, tend, v_ad )
    153153
    154154!
  • palm/trunk/SOURCE/advec_w_ups.f90

    r4 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Arguments removed from transpose routines
    77!
    88! Former revisions:
     
    6969!
    7070!-- Transpose the component to be advected: z --> x
    71     CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
     71    CALL transpose_zx( v_ad, tend, v_ad )
    7272
    7373#else
     
    9797!
    9898!-- Transpose the component to be advected: z --> x
    99     CALL transpose_zx( d, tend, d, tend, d )
     99    CALL transpose_zx( d, tend, d )
    100100
    101101#endif
     
    123123!
    124124!-- Transpose the advecting component: z --> y
    125     CALL transpose_zx( d, tend, d, tend, d )
    126     CALL transpose_xy( d, tend, d, tend, d )
     125    CALL transpose_zx( d, tend, d )
     126    CALL transpose_xy( d, tend, d )
    127127
    128128!
    129129!-- Transpose the component to be advected: x --> y
    130     CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
     130    CALL transpose_xy( v_ad, tend, v_ad )
    131131
    132132#endif
     
    145145!
    146146!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
    147     CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
    148     CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
     147    CALL transpose_yx( v_ad, tend, v_ad )
     148    CALL transpose_xz( v_ad, tend, v_ad )
    149149
    150150!
  • palm/trunk/SOURCE/calc_spectra.f90

    r146 r164  
    44! Actual revisions:
    55! -----------------
    6 ! user-defined spectra
     6! user-defined spectra, arguments removed from transpose routines
    77!
    88! Former revisions:
     
    7777#if defined( __parallel )
    7878          IF ( pdims(2) /= 1 )  THEN
    79              CALL transpose_zx( d, tend, d, tend, d )
     79             CALL transpose_zx( d, tend, d )
    8080          ELSE
    81              CALL transpose_yxd( d, tend, d, tend, d )
     81             CALL transpose_yxd( d, tend, d )
    8282          ENDIF
    8383          CALL calc_spectra_x( d, pr, m )
     
    110110
    111111#if defined( __parallel )
    112           CALL transpose_zyd( d, tend, d, tend, d )
     112          CALL transpose_zyd( d, tend, d )
    113113          CALL calc_spectra_y( d, pr, m )
    114114#else
  • palm/trunk/SOURCE/palm.f90

    r114 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Workaround for getting information about the coupling mode
    77!
    88! Former revisions:
     
    8181!
    8282!-- Get information about the coupling mode from the environment variable
    83 !-- which has been set by the mpiexec command
    84     CALL local_getenv( 'coupling_mode', 13, coupling_mode, i )
    85     IF ( i == 0 )  coupling_mode = 'uncoupled'
     83!-- which has been set by the mpiexec command.
     84!-- This method is currently not used because the mpiexec command is not
     85!-- available on some machines
     86!    CALL local_getenv( 'coupling_mode', 13, coupling_mode, i )
     87!    IF ( i == 0 )  coupling_mode = 'uncoupled'
     88!    IF ( coupling_mode == 'ocean_to_atmosphere' )  coupling_char = '_O'
     89
     90!
     91!-- Get information about the coupling mode from standard input (PE0 only) and
     92!-- distribute it to the other PEs
     93    CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
     94    IF ( myid == 0 )  THEN
     95       READ (*,*,ERR=10,END=10)  coupling_mode
     9610     IF ( TRIM( coupling_mode ) == 'atmosphere_to_ocean' )  THEN
     97          i = 1
     98       ELSEIF ( TRIM( coupling_mode ) ==  'ocean_to_atmosphere' )  THEN
     99          i = 2
     100       ELSE
     101          i = 0
     102       ENDIF
     103    ENDIF
     104    CALL MPI_BCAST( i, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )
     105    IF ( i == 0 )  THEN
     106       coupling_mode = 'uncoupled'
     107    ELSEIF ( i == 1 )  THEN
     108       coupling_mode = 'atmosphere_to_ocean'
     109    ELSEIF ( i == 2 )  THEN
     110       coupling_mode = 'ocean_to_atmosphere'
     111    ENDIF
    86112    IF ( coupling_mode == 'ocean_to_atmosphere' )  coupling_char = '_O'
    87113#endif
  • palm/trunk/SOURCE/poisfft.f90

    r139 r164  
    44! Actual revisions:
    55! -----------------
    6 !
     6! Arguments removed from transpose routines
    77!
    88! Former revisions:
     
    152152!--       Transposition z --> x
    153153          CALL cpu_log( log_point_s(5), 'transpo forward', 'start' )
    154           CALL transpose_zx( ar, work, ar, work, ar )
     154          CALL transpose_zx( ar, work, ar )
    155155          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
    156156
     
    162162!--       Transposition x --> y
    163163          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
    164           CALL transpose_xy( ar, work, ar, work, ar )
     164          CALL transpose_xy( ar, work, ar )
    165165          CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
    166166
     
    172172!--       Transposition y --> z
    173173          CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
    174           CALL transpose_yz( ar, work, ar, work, ar )
     174          CALL transpose_yz( ar, work, ar )
    175175          CALL cpu_log( log_point_s(5), 'transpo forward', 'stop' )
    176176
     
    185185!--       Transposition z --> y
    186186          CALL cpu_log( log_point_s(8), 'transpo invers', 'start' )
    187           CALL transpose_zy( ar, work, ar, work, ar )
     187          CALL transpose_zy( ar, work, ar )
    188188          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
    189189
     
    195195!--       Transposition y --> x
    196196          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
    197           CALL transpose_yx( ar, work, ar, work, ar )
     197          CALL transpose_yx( ar, work, ar )
    198198          CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
    199199
     
    205205!--       Transposition x --> z
    206206          CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
    207           CALL transpose_xz( ar, work, ar, work, ar )
     207          CALL transpose_xz( ar, work, ar )
    208208          CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
    209209
  • palm/trunk/SOURCE/transpose.f90

    r4 r164  
    1  SUBROUTINE transpose_xy( f_in, work1, f_inv, work2, f_out )
     1 SUBROUTINE transpose_xy( f_in, work, f_out )
    22
    33!------------------------------------------------------------------------------!
    44! Actual revisions:
    55! -----------------
    6 !
     6! f_inv changed from subroutine argument to automatic array in order to do
     7! re-ordering from f_in to f_inv in one step, one array work is needed instead
     8! of work1 and work2
    79!
    810! Former revisions:
     
    4446             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
    4547             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
    46              work1(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), work2(nnx*nny*nnz)
     48             work(nnx*nny*nnz)
    4749
    4850#if defined( __parallel )
     
    5153!-- Rearrange indices of input array in order to make data to be send
    5254!-- by MPI contiguous
    53     DO  k = nzb_x, nzt_xa
    54        DO  j = nys_x, nyn_xa
    55           DO  i = 0, nxa
    56              work1(j,k,i) = f_in(i,j,k)
    57           ENDDO
    58        ENDDO
    59     ENDDO
    60 
    61 !
    62 !-- Move data to different array, because memory location of work1 is
    63 !-- needed further below (work1 = work2)
    6455    DO  i = 0, nxa
    6556       DO  k = nzb_x, nzt_xa
    6657          DO  j = nys_x, nyn_xa
    67              f_inv(j,k,i) = work1(j,k,i)
     58             f_inv(j,k,i) = f_in(i,j,k)
    6859          ENDDO
    6960       ENDDO
     
    7465    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    7566    CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
    76                        work2(1),             sendrecvcount_xy, MPI_REAL, &
     67                       work(1),              sendrecvcount_xy, MPI_REAL, &
    7768                       comm1dy, ierr )
    7869    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    8778             DO  j = ys, ys + nyn_xa - nys_x
    8879                m = m + 1
    89                 f_out(j,i,k) = work2(m)
     80                f_out(j,i,k) = work(m)
    9081             ENDDO
    9182          ENDDO
     
    9889
    9990
    100  SUBROUTINE transpose_xz( f_in, work1, f_inv, work2, f_out )
     91 SUBROUTINE transpose_xz( f_in, work, f_out )
    10192
    10293!------------------------------------------------------------------------------!
     
    119110   
    120111    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),             &
    121              f_inv(nxl:nxra,nys:nyna,1:nza),                    &
     112             f_inv(nys:nyna,nxl:nxra,1:nza),                    &
    122113             f_out(1:nza,nys:nyna,nxl:nxra),                    &
    123              work1(1:nza,nys:nyna,nxl:nxra), work2(nnx*nny*nnz)
     114             work(nnx*nny*nnz)
    124115
    125116#if defined( __parallel )
     
    135126          xs = 0 + l * nnx
    136127          DO  k = nzb_x, nzt_xa
    137              DO  j = nys_x, nyn_xa
    138                 DO  i = xs, xs + nnx - 1
     128             DO  i = xs, xs + nnx - 1
     129                DO  j = nys_x, nyn_xa
    139130                   m = m + 1
    140                    work2(m) = f_in(i,j,k)
     131                   work(m) = f_in(i,j,k)
    141132                ENDDO
    142133             ENDDO
     
    147138!--    Transpose array
    148139       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    149        CALL MPI_ALLTOALL( work2(1),         sendrecvcount_zx, MPI_REAL, &
    150                           f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
     140       CALL MPI_ALLTOALL( work(1),          sendrecvcount_zx, MPI_REAL, &
     141                          f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
    151142                          comm1dx, ierr )
    152143       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    154145!
    155146!--    Reorder transposed array in a way that the z index is in first position
    156        DO  i = nxl, nxra
    157           DO  j = nys, nyna
    158              DO  k = 1, nza
    159                 work1(k,j,i) = f_inv(i,j,k)
     147       DO  k = 1, nza
     148          DO  i = nxl, nxra
     149             DO  j = nys, nyna
     150                f_out(k,j,i) = f_inv(j,i,k)
    160151             ENDDO
    161152          ENDDO
     
    167158          DO  j = nys, nyna
    168159             DO  k = 1, nza
    169                 work1(k,j,i) = f_in(i,j,k)
    170              ENDDO
    171           ENDDO
    172        ENDDO
     160                f_inv(j,i,k) = f_in(i,j,k)
     161             ENDDO
     162          ENDDO
     163       ENDDO
     164
     165       DO  k = 1, nza
     166          DO  i = nxl, nxra
     167             DO  j = nys, nyna
     168                f_out(k,j,i) = f_inv(j,i,k)
     169             ENDDO
     170          ENDDO
     171       ENDDO
     172
    173173    ENDIF
    174174
    175 !
    176 !-- Move data to output array
    177     DO  i = nxl, nxra
    178        DO  j = nys, nyna
    179           DO  k = 1, nza
    180              f_out(k,j,i) = work1(k,j,i)
    181           ENDDO
    182        ENDDO
    183     ENDDO
    184175
    185176#endif
     
    188179
    189180
    190  SUBROUTINE transpose_yx( f_in, work1, f_inv, work2, f_out )
     181 SUBROUTINE transpose_yx( f_in, work, f_out )
    191182
    192183!------------------------------------------------------------------------------!
     
    211202             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
    212203             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                    &
    213              work1(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), work2(nnx*nny*nnz)
     204             work(nnx*nny*nnz)
    214205
    215206#if defined( __parallel )
     
    224215             DO  j = ys, ys + nyn_xa - nys_x
    225216                m = m + 1
    226                 work2(m) = f_in(j,i,k)
     217                work(m) = f_in(j,i,k)
    227218             ENDDO
    228219          ENDDO
     
    233224!-- Transpose array
    234225    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    235     CALL MPI_ALLTOALL( work2(1),             sendrecvcount_xy, MPI_REAL, &
     226    CALL MPI_ALLTOALL( work(1),              sendrecvcount_xy, MPI_REAL, &
    236227                       f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
    237228                       comm1dy, ierr )
     
    243234       DO  k = nzb_x, nzt_xa
    244235          DO  j = nys_x, nyn_xa
    245              work1(i,j,k) = f_inv(j,k,i)
    246           ENDDO
    247        ENDDO
    248     ENDDO
    249 
    250 !
    251 !-- Move data to output array
    252     DO  k = nzb_x, nzt_xa
    253        DO  j = nys_x, nyn_xa
    254           DO  i = 0, nxa
    255              f_out(i,j,k) = work1(i,j,k)
     236             f_out(i,j,k) = f_inv(j,k,i)
    256237          ENDDO
    257238       ENDDO
     
    263244
    264245
    265  SUBROUTINE transpose_yxd( f_in, work1, f_inv, work2, f_out )
     246 SUBROUTINE transpose_yxd( f_in, work, f_out )
    266247
    267248!------------------------------------------------------------------------------!
     
    287268    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &
    288269             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
    289              work1(nxl:nxra,1:nza,nys:nyna), work2(nnx*nny*nnz)
     270             work(nnx*nny*nnz)
    290271
    291272#if defined( __parallel )
     
    297278       DO  j = nys, nyna
    298279          DO  i = nxl, nxra
    299              work1(i,k,j) = f_in(k,j,i)
    300           ENDDO
    301        ENDDO
    302     ENDDO
    303 
    304 !
    305 !-- Move data to different array, because memory location of work1 is
    306 !-- needed further below (work1 = work2)
    307     DO  j = nys, nyna
    308        DO  k = 1, nza
    309           DO  i = nxl, nxra
    310              f_inv(i,k,j) = work1(i,k,j)
     280             f_inv(i,k,j) = f_in(k,j,i)
    311281          ENDDO
    312282       ENDDO
     
    317287    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    318288    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
    319                        work2(1),         sendrecvcount_xy, MPI_REAL, &
     289                       work(1),          sendrecvcount_xy, MPI_REAL, &
    320290                       comm1dx, ierr )
    321291    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    330300             DO  i = xs, xs + nnx - 1
    331301                m = m + 1
    332                 f_out(i,j,k) = work2(m)
     302                f_out(i,j,k) = work(m)
    333303             ENDDO
    334304          ENDDO
     
    341311
    342312
    343  SUBROUTINE transpose_yz( f_in, work1, f_inv, work2, f_out )
     313 SUBROUTINE transpose_yz( f_in, work, f_out )
    344314
    345315!------------------------------------------------------------------------------!
     
    364334             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
    365335             f_out(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                    &
    366              work1(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), work2(nnx*nny*nnz)
     336             work(nnx*nny*nnz)
    367337
    368338#if defined( __parallel )
     
    371341!-- Rearrange indices of input array in order to make data to be send
    372342!-- by MPI contiguous
    373     DO  k = nzb_y, nzt_ya
    374        DO  i = nxl_y, nxr_ya
    375           DO  j = 0, nya
    376              work1(i,k,j) = f_in(j,i,k)
     343    DO  j = 0, nya
     344       DO  k = nzb_y, nzt_ya
     345          DO  i = nxl_y, nxr_ya
     346             f_inv(i,k,j) = f_in(j,i,k)
    377347          ENDDO
    378348       ENDDO
     
    388358          DO  k = nzb_y, nzt_ya
    389359             DO  i = nxl_y, nxr_ya
    390                 f_out(i,j,k) = work1(i,k,j)
     360                f_out(i,j,k) = f_inv(i,k,j)
    391361             ENDDO
    392362          ENDDO
    393363       ENDDO
    394364       RETURN
    395     ELSE
    396        DO  j = 0, nya
    397           DO  k = nzb_y, nzt_ya
    398              DO  i = nxl_y, nxr_ya
    399                 f_inv(i,k,j) = work1(i,k,j)
    400              ENDDO
    401           ENDDO
    402        ENDDO
    403365    ENDIF
    404366
     
    407369    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    408370    CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
    409                        work2(1),             sendrecvcount_yz, MPI_REAL, &
     371                       work(1),              sendrecvcount_yz, MPI_REAL, &
    410372                       comm1dx, ierr )
    411373    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    420382             DO  i = nxl_z, nxr_za
    421383                m = m + 1
    422                 f_out(i,j,k) = work2(m)
     384                f_out(i,j,k) = work(m)
    423385             ENDDO
    424386          ENDDO
     
    431393
    432394
    433  SUBROUTINE transpose_zx( f_in, work1, f_inv, work2, f_out )
     395 SUBROUTINE transpose_zx( f_in, work, f_out )
    434396
    435397!------------------------------------------------------------------------------!
     
    451413    INTEGER ::  i, j, k, l, m, xs
    452414   
    453     REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,nys:nyna,1:nza), &
     415    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
    454416             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
    455              work1(nxl:nxra,nys:nyna,1:nza), work2(nnx*nny*nnz)
     417             work(nnx*nny*nnz)
    456418
    457419#if defined( __parallel )
     
    460422!-- Rearrange indices of input array in order to make data to be send
    461423!-- by MPI contiguous
    462     DO  i = nxl, nxra
    463        DO  j = nys, nyna
    464           DO  k = 1,nza
    465              work1(i,j,k) = f_in(k,j,i)
     424    DO  k = 1,nza
     425       DO  i = nxl, nxra
     426          DO  j = nys, nyna
     427             f_inv(j,i,k) = f_in(k,j,i)
    466428          ENDDO
    467429       ENDDO
     
    475437    IF ( pdims(1) == 1 )  THEN
    476438       DO  k = 1, nza
    477           DO  j = nys, nyna
    478              DO  i = nxl, nxra
    479                 f_out(i,j,k) = work1(i,j,k)
     439          DO  i = nxl, nxra
     440             DO  j = nys, nyna
     441                f_out(i,j,k) = f_inv(j,i,k)
    480442             ENDDO
    481443          ENDDO
    482444       ENDDO
    483445       RETURN
    484     ELSE
    485        DO  k = 1, nza
    486           DO  j = nys, nyna
    487              DO  i = nxl, nxra
    488                 f_inv(i,j,k) = work1(i,j,k)
    489              ENDDO
    490           ENDDO
    491        ENDDO
    492446    ENDIF
    493447
     
    495449!-- Transpose array
    496450    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    497     CALL MPI_ALLTOALL( f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
    498                        work2(1),         sendrecvcount_zx, MPI_REAL, &
     451    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
     452                       work(1),          sendrecvcount_zx, MPI_REAL, &
    499453                       comm1dx, ierr )
    500454    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    506460       xs = 0 + l * nnx
    507461       DO  k = nzb_x, nzt_xa
    508           DO  j = nys_x, nyn_xa
    509              DO  i = xs, xs + nnx - 1
     462          DO  i = xs, xs + nnx - 1
     463             DO  j = nys_x, nyn_xa
    510464                m = m + 1
    511                 f_out(i,j,k) = work2(m)
     465                f_out(i,j,k) = work(m)
    512466             ENDDO
    513467          ENDDO
     
    520474
    521475
    522  SUBROUTINE transpose_zy( f_in, work1, f_inv, work2, f_out )
     476 SUBROUTINE transpose_zy( f_in, work, f_out )
    523477
    524478!------------------------------------------------------------------------------!
     
    543497             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
    544498             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
    545              work1(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), work2(nnx*nny*nnz)
     499             work(nnx*nny*nnz)
    546500
    547501#if defined( __parallel )
     
    560514                DO  i = nxl_z, nxr_za
    561515                   m = m + 1
    562                    work2(m) = f_in(i,j,k)
     516                   work(m) = f_in(i,j,k)
    563517                ENDDO
    564518             ENDDO
     
    569523!--    Transpose array
    570524       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    571        CALL MPI_ALLTOALL( work2(1),             sendrecvcount_yz, MPI_REAL, &
     525       CALL MPI_ALLTOALL( work(1),              sendrecvcount_yz, MPI_REAL, &
    572526                          f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
    573527                          comm1dx, ierr )
     
    576530!
    577531!--    Reorder transposed array in a way that the y index is in first position
     532       DO  j = 0, nya
     533          DO  k = nzb_y, nzt_ya
     534             DO  i = nxl_y, nxr_ya
     535                f_out(j,i,k) = f_inv(i,k,j)
     536             ENDDO
     537          ENDDO
     538       ENDDO
     539    ELSE
     540!
     541!--    Reorder the array in a way that the y index is in first position
     542       DO  k = nzb_y, nzt_ya
     543          DO  j = 0, nya
     544             DO  i = nxl_y, nxr_ya
     545                f_inv(i,k,j) = f_in(i,j,k)
     546             ENDDO
     547          ENDDO
     548       ENDDO
     549!
     550!--    Move data to output array
    578551       DO  k = nzb_y, nzt_ya
    579552          DO  i = nxl_y, nxr_ya
    580553             DO  j = 0, nya
    581                 work1(j,i,k) = f_inv(i,k,j)
    582              ENDDO
    583           ENDDO
    584        ENDDO
    585     ELSE
    586 !
    587 !--    Reorder the array in a way that the y index is in first position
    588        DO  k = nzb_y, nzt_ya
    589           DO  i = nxl_y, nxr_ya
    590              DO  j = 0, nya
    591                 work1(j,i,k) = f_in(i,j,k)
    592              ENDDO
    593           ENDDO
    594        ENDDO
     554                f_out(j,i,k) = f_inv(i,k,j)
     555             ENDDO
     556          ENDDO
     557       ENDDO
     558
    595559    ENDIF
    596560
    597 !
    598 !-- Move data to output array
    599     DO  k = nzb_y, nzt_ya
    600        DO  i = nxl_y, nxr_ya
    601           DO  j = 0, nya
    602              f_out(j,i,k) = work1(j,i,k)
    603           ENDDO
    604        ENDDO
    605     ENDDO
    606 
    607561#endif
    608562
     
    610564
    611565
    612  SUBROUTINE transpose_zyd( f_in, work1, f_inv, work2, f_out )
     566 SUBROUTINE transpose_zyd( f_in, work, f_out )
    613567
    614568!------------------------------------------------------------------------------!
     
    634588    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
    635589             f_out(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda),                    &
    636              work1(nys:nyna,nxl:nxra,1:nza), work2(nnx*nny*nnz)
     590             work(nnx*nny*nnz)
    637591
    638592#if defined( __parallel )
     
    644598       DO  j = nys, nyna
    645599          DO  k = 1, nza
    646              work1(j,i,k) = f_in(k,j,i)
     600             f_inv(j,i,k) = f_in(k,j,i)
    647601          ENDDO
    648602       ENDDO
     
    658612          DO  i = nxl, nxra
    659613             DO  j = nys, nyna
    660                 f_out(j,i,k) = work1(j,i,k)
     614                f_out(j,i,k) = f_inv(j,i,k)
    661615             ENDDO
    662616          ENDDO
    663617       ENDDO
    664618       RETURN
    665     ELSE
    666        DO  k = 1, nza
    667           DO  i = nxl, nxra
    668              DO  j = nys, nyna
    669                 f_inv(j,i,k) = work1(j,i,k)
    670              ENDDO
    671           ENDDO
    672        ENDDO
    673619    ENDIF
    674620
     
    677623    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    678624    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
    679                        work2(1),         sendrecvcount_zyd, MPI_REAL, &
     625                       work(1),          sendrecvcount_zyd, MPI_REAL, &
    680626                       comm1dy, ierr )
    681627    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    690636             DO  j = ys, ys + nny - 1
    691637                m = m + 1
    692                 f_out(j,i,k) = work2(m)
     638                f_out(j,i,k) = work(m)
    693639             ENDDO
    694640          ENDDO
Note: See TracChangeset for help on using the changeset viewer.