|
CP2K 2.4 (Revision 12889)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00010 MODULE averages_types 00011 USE cell_types, ONLY: cell_type 00012 USE colvar_utils, ONLY: get_clv_force,& 00013 number_of_colvar 00014 USE cp_output_handling, ONLY: cp_print_key_finished_output,& 00015 cp_print_key_unit_nr 00016 USE f77_blas 00017 USE force_env_types, ONLY: force_env_type 00018 USE input_section_types, ONLY: section_vals_get,& 00019 section_vals_get_subs_vals,& 00020 section_vals_remove_values,& 00021 section_vals_type,& 00022 section_vals_val_get 00023 USE kinds, ONLY: default_string_length,& 00024 dp 00025 USE md_ener_types, ONLY: md_ener_type 00026 USE timings, ONLY: timeset,& 00027 timestop 00028 USE virial_types, ONLY: virial_create,& 00029 virial_release,& 00030 virial_type 00031 #include "cp_common_uses.h" 00032 00033 IMPLICIT NONE 00034 00035 PRIVATE 00036 00037 ! ***************************************************************************** 00038 TYPE average_quantities_type 00039 INTEGER :: id_nr, ref_count, itimes_start 00040 LOGICAL :: do_averages 00041 TYPE(section_vals_type), POINTER :: averages_section 00042 ! Real Scalar Quantities 00043 REAL(KIND=dp) :: avetemp, avepot, avekin, 00044 avevol, aveca, avecb, avecc 00045 REAL(KIND=dp) :: avetemp_baro, avehugoniot, avecpu 00046 REAL(KIND=dp) :: aveal, avebe, avega, avepress, 00047 avekinc, avetempc, avepxx 00048 REAL(KIND=dp) :: avetemp_qm, avekin_qm, econs 00049 ! Virial 00050 TYPE(virial_type), POINTER :: virial 00051 ! Colvar 00052 REAL(KIND=dp), POINTER, DIMENSION(:) :: avecolvar 00053 REAL(KIND=dp), POINTER, DIMENSION(:) :: aveMmatrix 00054 END TYPE average_quantities_type 00055 00056 ! ***************************************************************************** 00057 INTERFACE get_averages 00058 MODULE PROCEDURE get_averages_rs, get_averages_rv, get_averages_rm 00059 END INTERFACE get_averages 00060 00061 ! *** Public subroutines and data types *** 00062 PUBLIC :: average_quantities_type, create_averages, release_averages,& 00063 retain_averages, compute_averages 00064 00065 ! *** Global parameters *** 00066 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'averages_types' 00067 INTEGER, SAVE, PRIVATE :: last_avg_env_id=0 00068 00069 CONTAINS 00070 00071 ! ***************************************************************************** 00075 SUBROUTINE create_averages(averages, averages_section, virial_avg, force_env, error) 00076 TYPE(average_quantities_type), POINTER :: averages 00077 TYPE(section_vals_type), POINTER :: averages_section 00078 LOGICAL, INTENT(IN), OPTIONAL :: virial_avg 00079 TYPE(force_env_type), POINTER :: force_env 00080 TYPE(cp_error_type), INTENT(INOUT) :: error 00081 00082 CHARACTER(LEN=*), PARAMETER :: routineN = 'create_averages', 00083 routineP = moduleN//':'//routineN 00084 00085 INTEGER :: i, nint, stat 00086 LOGICAL :: do_colvars, failure 00087 00088 failure = .FALSE. 00089 ALLOCATE (averages, stat=stat) 00090 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00091 NULLIFY(averages%virial) 00092 NULLIFY(averages%avecolvar) 00093 NULLIFY(averages%aveMmatrix) 00094 ! Point to the averages section 00095 averages%averages_section => averages_section 00096 ! Initialize averages 00097 last_avg_env_id=last_avg_env_id+1 00098 averages%id_nr=last_avg_env_id 00099 averages%ref_count = 1 00100 averages%itimes_start = -1 00101 averages%avetemp = 0.0_dp 00102 averages%avepot = 0.0_dp 00103 averages%avekin = 0.0_dp 00104 averages%avevol = 0.0_dp 00105 averages%aveca = 0.0_dp 00106 averages%avecb = 0.0_dp 00107 averages%avecc = 0.0_dp 00108 averages%avetemp_baro = 0.0_dp 00109 averages%avehugoniot = 0.0_dp 00110 averages%avecpu = 0.0_dp 00111 averages%aveal = 0.0_dp 00112 averages%avebe = 0.0_dp 00113 averages%avega = 0.0_dp 00114 averages%avepress = 0.0_dp 00115 averages%avekinc = 0.0_dp 00116 averages%avetempc = 0.0_dp 00117 averages%avepxx = 0.0_dp 00118 averages%avetemp_qm = 0.0_dp 00119 averages%avekin_qm = 0.0_dp 00120 averages%econs = 0.0_dp 00121 CALL section_vals_val_get(averages_section,"_SECTION_PARAMETERS_",l_val=averages%do_averages,& 00122 error=error) 00123 IF (averages%do_averages) THEN 00124 ! Setup Virial if requested 00125 IF (PRESENT(virial_avg)) THEN 00126 IF (virial_avg) CALL virial_create(averages%virial, error) 00127 END IF 00128 CALL section_vals_val_get(averages_section,"AVERAGE_COLVAR",l_val=do_colvars,error=error) 00129 ! Total number of COLVARs 00130 nint = 0 00131 IF (do_colvars) nint = number_of_colvar(force_env, error=error) 00132 ALLOCATE(averages%avecolvar(nint), stat=stat) 00133 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00134 ALLOCATE(averages%aveMmatrix(nint*nint), stat=stat) 00135 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00136 DO i = 1, nint 00137 averages%avecolvar(i) = 0.0_dp 00138 END DO 00139 DO i = 1, nint*nint 00140 averages%aveMmatrix(i) = 0.0_dp 00141 END DO 00142 END IF 00143 END SUBROUTINE create_averages 00144 00145 ! ***************************************************************************** 00149 SUBROUTINE retain_averages(averages, error) 00150 TYPE(average_quantities_type), POINTER :: averages 00151 TYPE(cp_error_type), INTENT(inout) :: error 00152 00153 CHARACTER(len=*), PARAMETER :: routineN = 'retain_averages', 00154 routineP = moduleN//':'//routineN 00155 00156 LOGICAL :: failure 00157 00158 failure=.FALSE. 00159 00160 CPPrecondition(ASSOCIATED(averages),cp_failure_level,routineP,error,failure) 00161 IF (.NOT. failure) THEN 00162 CPPrecondition(averages%ref_count>0,cp_failure_level,routineP,error,failure) 00163 averages%ref_count=averages%ref_count+1 00164 END IF 00165 END SUBROUTINE retain_averages 00166 00167 ! ***************************************************************************** 00171 SUBROUTINE release_averages(averages, error) 00172 TYPE(average_quantities_type), POINTER :: averages 00173 TYPE(cp_error_type), INTENT(inout) :: error 00174 00175 CHARACTER(len=*), PARAMETER :: routineN = 'release_averages', 00176 routineP = moduleN//':'//routineN 00177 00178 INTEGER :: stat 00179 LOGICAL :: failure 00180 TYPE(section_vals_type), POINTER :: work_section 00181 00182 failure=.FALSE. 00183 IF (ASSOCIATED(averages)) THEN 00184 CPPrecondition(averages%ref_count>0,cp_failure_level,routineP,error,failure) 00185 averages%ref_count=averages%ref_count-1 00186 IF (averages%ref_count==0) THEN 00187 CALL virial_release(averages%virial, error) 00188 IF (ASSOCIATED(averages%avecolvar)) THEN 00189 DEALLOCATE(averages%avecolvar, stat=stat) 00190 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00191 END IF 00192 IF (ASSOCIATED(averages%aveMmatrix)) THEN 00193 DEALLOCATE(averages%aveMmatrix, stat=stat) 00194 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00195 END IF 00196 ! Removes restart values from the corresponding restart section.. 00197 work_section => section_vals_get_subs_vals(averages%averages_section,"RESTART_AVERAGES",error=error) 00198 CALL section_vals_remove_values(work_section, error) 00199 NULLIFY(averages%averages_section) 00200 ! 00201 DEALLOCATE(averages,stat=stat) 00202 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00203 END IF 00204 END IF 00205 00206 END SUBROUTINE release_averages 00207 00208 ! ***************************************************************************** 00212 SUBROUTINE compute_averages (averages, force_env, md_ener, cell, virial, & 00213 pv_scalar, pv_xx, used_time, hugoniot, abc, cell_angle, nat, itimes, & 00214 time, my_pos, my_act, error) 00215 TYPE(average_quantities_type), POINTER :: averages 00216 TYPE(force_env_type), POINTER :: force_env 00217 TYPE(md_ener_type), POINTER :: md_ener 00218 TYPE(cell_type), POINTER :: cell 00219 TYPE(virial_type), POINTER :: virial 00220 REAL(KIND=dp), INTENT(IN) :: pv_scalar, pv_xx 00221 REAL(KIND=dp), POINTER :: used_time 00222 REAL(KIND=dp), INTENT(IN) :: hugoniot 00223 REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: abc, cell_angle 00224 INTEGER, INTENT(IN) :: nat, itimes 00225 REAL(KIND=dp), INTENT(IN) :: time 00226 CHARACTER(LEN=default_string_length), 00227 INTENT(IN) :: my_pos, my_act 00228 TYPE(cp_error_type), INTENT(inout) :: error 00229 00230 CHARACTER(len=*), PARAMETER :: routineN = 'compute_averages', 00231 routineP = moduleN//':'//routineN 00232 00233 CHARACTER(LEN=default_string_length) :: ctmp 00234 INTEGER :: delta_t, handle, i, nint, 00235 output_unit, stat 00236 LOGICAL :: failure, restart_averages 00237 REAL(KIND=dp) :: start_time 00238 REAL(KIND=dp), DIMENSION(:), POINTER :: cvalues, Mmatrix, tmp 00239 TYPE(cp_logger_type), POINTER :: logger 00240 TYPE(section_vals_type), POINTER :: restart_section 00241 00242 failure = .FALSE. 00243 CALL timeset(routineN,handle) 00244 CALL section_vals_val_get(averages%averages_section,"ACQUISITION_START_TIME",& 00245 r_val=start_time, error=error) 00246 IF (averages%do_averages) THEN 00247 NULLIFY(cvalues, Mmatrix, logger) 00248 logger => cp_error_get_logger(error) 00249 ! Determine the nr. of internal colvar (if any/requested) 00250 nint = 0 00251 IF (ASSOCIATED(averages%avecolvar)) nint = SIZE(averages%avecolvar) 00252 00253 ! Evaluate averages if we collected enough statistics (user defined) 00254 IF (time>=start_time) THEN 00255 00256 ! Handling properly the restart 00257 IF (averages%itimes_start==-1) THEN 00258 restart_section => section_vals_get_subs_vals(averages%averages_section,"RESTART_AVERAGES",error=error) 00259 CALL section_vals_get(restart_section, explicit=restart_averages, error=error) 00260 IF (restart_averages) THEN 00261 CALL section_vals_val_get(restart_section,"ITIMES_START",i_val=averages%itimes_start,error=error) 00262 CALL section_vals_val_get(restart_section,"AVECPU",r_val=averages%avecpu,error=error) 00263 CALL section_vals_val_get(restart_section,"AVEHUGONIOT",r_val=averages%avehugoniot,error=error) 00264 CALL section_vals_val_get(restart_section,"AVETEMP_BARO",r_val=averages%avetemp_baro,error=error) 00265 CALL section_vals_val_get(restart_section,"AVEPOT",r_val=averages%avepot,error=error) 00266 CALL section_vals_val_get(restart_section,"AVEKIN",r_val=averages%avekin,error=error) 00267 CALL section_vals_val_get(restart_section,"AVETEMP",r_val=averages%avetemp,error=error) 00268 CALL section_vals_val_get(restart_section,"AVEKIN_QM",r_val=averages%avekin_qm,error=error) 00269 CALL section_vals_val_get(restart_section,"AVETEMP_QM",r_val=averages%avetemp_qm,error=error) 00270 CALL section_vals_val_get(restart_section,"AVEVOL",r_val=averages%avevol,error=error) 00271 CALL section_vals_val_get(restart_section,"AVECELL_A",r_val=averages%aveca,error=error) 00272 CALL section_vals_val_get(restart_section,"AVECELL_B",r_val=averages%avecb,error=error) 00273 CALL section_vals_val_get(restart_section,"AVECELL_C",r_val=averages%avecc,error=error) 00274 CALL section_vals_val_get(restart_section,"AVEALPHA",r_val=averages%aveal,error=error) 00275 CALL section_vals_val_get(restart_section,"AVEBETA",r_val=averages%avebe,error=error) 00276 CALL section_vals_val_get(restart_section,"AVEGAMMA",r_val=averages%avega,error=error) 00277 CALL section_vals_val_get(restart_section,"AVE_ECONS",r_val=averages%econs,error=error) 00278 ! Virial 00279 IF (virial%pv_availability) THEN 00280 CALL section_vals_val_get(restart_section,"AVE_PRESS",r_val=averages%avepress,error=error) 00281 CALL section_vals_val_get(restart_section,"AVE_PXX",r_val=averages%avepxx,error=error) 00282 IF (ASSOCIATED(averages%virial)) THEN 00283 CALL section_vals_val_get(restart_section,"AVE_PV_TOT",r_vals=tmp,error=error) 00284 averages%virial%pv_total = RESHAPE(tmp,(/3,3/)) 00285 CALL section_vals_val_get(restart_section,"AVE_PV_VIR",r_vals=tmp,error=error) 00286 averages%virial%pv_virial = RESHAPE(tmp,(/3,3/)) 00287 CALL section_vals_val_get(restart_section,"AVE_PV_KIN",r_vals=tmp,error=error) 00288 averages%virial%pv_kinetic = RESHAPE(tmp,(/3,3/)) 00289 CALL section_vals_val_get(restart_section,"AVE_PV_CNSTR",r_vals=tmp,error=error) 00290 averages%virial%pv_constraint = RESHAPE(tmp,(/3,3/)) 00291 CALL section_vals_val_get(restart_section,"AVE_PV_XC",r_vals=tmp,error=error) 00292 averages%virial%pv_xc = RESHAPE(tmp,(/3,3/)) 00293 CALL section_vals_val_get(restart_section,"AVE_PV_FOCK_4C",r_vals=tmp,error=error) 00294 averages%virial%pv_fock_4c = RESHAPE(tmp,(/3,3/)) 00295 END IF 00296 END IF 00297 ! Colvars 00298 IF (nint>0) THEN 00299 CALL section_vals_val_get(restart_section,"AVE_COLVARS",r_vals=cvalues,error=error) 00300 CALL section_vals_val_get(restart_section,"AVE_MMATRIX",r_vals=Mmatrix,error=error) 00301 CPPostcondition(nint==SIZE(cvalues),cp_failure_level,routineP,error,failure) 00302 CPPostcondition(nint*nint==SIZE(Mmatrix),cp_failure_level,routineP,error,failure) 00303 averages%avecolvar = cvalues 00304 averages%aveMmatrix = Mmatrix 00305 END IF 00306 ELSE 00307 averages%itimes_start = itimes 00308 END IF 00309 END IF 00310 delta_t = itimes - averages%itimes_start + 1 00311 00312 ! Perform averages 00313 SELECT CASE (delta_t) 00314 CASE (1) 00315 averages%avecpu = used_time 00316 averages%avehugoniot = hugoniot 00317 averages%avetemp_baro = md_ener%temp_baro 00318 averages%avepot = md_ener%epot 00319 averages%avekin = md_ener%ekin 00320 averages%avetemp = md_ener%temp_part 00321 averages%avekin_qm = md_ener%ekin_qm 00322 averages%avetemp_qm = md_ener%temp_qm 00323 averages%avevol = cell%deth 00324 averages%aveca = abc(1) 00325 averages%avecb = abc(2) 00326 averages%avecc = abc(3) 00327 averages%aveal = cell_angle(3) 00328 averages%avebe = cell_angle(2) 00329 averages%avega = cell_angle(1) 00330 averages%econs = 0._dp 00331 ! Virial 00332 IF (virial%pv_availability) THEN 00333 averages%avepress = pv_scalar 00334 averages%avepxx = pv_xx 00335 IF (ASSOCIATED(averages%virial)) THEN 00336 averages%virial%pv_total = virial%pv_total 00337 averages%virial%pv_virial = virial%pv_virial 00338 averages%virial%pv_kinetic = virial%pv_kinetic 00339 averages%virial%pv_constraint = virial%pv_constraint 00340 averages%virial%pv_xc = virial%pv_xc 00341 averages%virial%pv_fock_4c = virial%pv_fock_4c 00342 END IF 00343 END IF 00344 ! Colvars 00345 IF (nint>0) THEN 00346 CALL get_clv_force(force_env, nsize_xyz=nat*3, nsize_int=nint, & 00347 cvalues=averages%avecolvar,Mmatrix=averages%aveMmatrix, error=error) 00348 END IF 00349 CASE DEFAULT 00350 CALL get_averages(averages%avecpu,used_time,delta_t,error) 00351 CALL get_averages(averages%avehugoniot,hugoniot,delta_t,error) 00352 CALL get_averages(averages%avetemp_baro,md_ener%temp_baro,delta_t,error) 00353 CALL get_averages(averages%avepot,md_ener%epot,delta_t,error) 00354 CALL get_averages(averages%avekin,md_ener%ekin,delta_t,error) 00355 CALL get_averages(averages%avetemp,md_ener%temp_part,delta_t,error) 00356 CALL get_averages(averages%avekin_qm,md_ener%ekin_qm,delta_t,error) 00357 CALL get_averages(averages%avetemp_qm,md_ener%temp_qm,delta_t,error) 00358 CALL get_averages(averages%avevol,cell%deth,delta_t,error) 00359 CALL get_averages(averages%aveca,abc(1),delta_t,error) 00360 CALL get_averages(averages%avecb,abc(2),delta_t,error) 00361 CALL get_averages(averages%avecc,abc(3),delta_t,error) 00362 CALL get_averages(averages%aveal,cell_angle(3),delta_t,error) 00363 CALL get_averages(averages%avebe,cell_angle(2),delta_t,error) 00364 CALL get_averages(averages%avega,cell_angle(1),delta_t,error) 00365 CALL get_averages(averages%econs,md_ener%delta_cons,delta_t,error) 00366 ! Virial 00367 IF (virial%pv_availability) THEN 00368 CALL get_averages(averages%avepress,pv_scalar,delta_t,error) 00369 CALL get_averages(averages%avepxx,pv_xx,delta_t,error) 00370 IF (ASSOCIATED(averages%virial)) THEN 00371 CALL get_averages(averages%virial%pv_total,virial%pv_total,delta_t,error) 00372 CALL get_averages(averages%virial%pv_virial,virial%pv_virial,delta_t,error) 00373 CALL get_averages(averages%virial%pv_kinetic,virial%pv_kinetic,delta_t,error) 00374 CALL get_averages(averages%virial%pv_constraint,virial%pv_constraint,delta_t,error) 00375 CALL get_averages(averages%virial%pv_xc,virial%pv_xc,delta_t,error) 00376 CALL get_averages(averages%virial%pv_fock_4c,virial%pv_fock_4c,delta_t,error) 00377 END IF 00378 END IF 00379 ! Colvars 00380 IF (nint>0) THEN 00381 ALLOCATE(cvalues(nint),stat=stat) 00382 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00383 ALLOCATE(Mmatrix(nint*nint),stat=stat) 00384 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00385 CALL get_clv_force(force_env, nsize_xyz=nat*3, nsize_int=nint, cvalues=cvalues,& 00386 Mmatrix=Mmatrix, error=error) 00387 CALL get_averages(averages%avecolvar, cvalues, delta_t,error) 00388 CALL get_averages(averages%aveMmatrix, Mmatrix, delta_t,error) 00389 DEALLOCATE(cvalues,stat=stat) 00390 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00391 DEALLOCATE(Mmatrix,stat=stat) 00392 CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) 00393 END IF 00394 END SELECT 00395 END IF 00396 00397 ! Possibly print averages 00398 output_unit = cp_print_key_unit_nr(logger,averages%averages_section,"PRINT_AVERAGES",& 00399 extension=".avg", file_position=my_pos, file_action=my_act, error=error) 00400 IF (output_unit>0) THEN 00401 WRITE(output_unit,FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)')& 00402 "AVECPU",averages%avecpu,itimes,& 00403 "AVEHUGONIOT",averages%avehugoniot,itimes,& 00404 "AVETEMP_BARO",averages%avetemp_baro,itimes,& 00405 "AVEPOT",averages%avepot,itimes,& 00406 "AVEKIN",averages%avekin,itimes,& 00407 "AVETEMP",averages%avetemp,itimes,& 00408 "AVEKIN_QM",averages%avekin_qm,itimes,& 00409 "AVETEMP_QM",averages%avetemp_qm,itimes,& 00410 "AVEVOL",averages%avevol,itimes,& 00411 "AVECELL_A",averages%aveca,itimes,& 00412 "AVECELL_B",averages%avecb,itimes,& 00413 "AVECELL_C",averages%avecc,itimes,& 00414 "AVEALPHA",averages%aveal,itimes,& 00415 "AVEBETA",averages%avebe,itimes,& 00416 "AVEGAMMA",averages%avega,itimes,& 00417 "AVE_ECONS",averages%econs,itimes 00418 ! Print the virial 00419 IF (virial%pv_availability) THEN 00420 WRITE(output_unit,FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)')& 00421 "AVE_PRESS",averages%avepress,itimes,& 00422 "AVE_PXX",averages%avepxx,itimes 00423 IF (ASSOCIATED(averages%virial)) THEN 00424 WRITE(output_unit,FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)')& 00425 "AVE_PV_TOT",averages%virial%pv_total,itimes,& 00426 "AVE_PV_VIR",averages%virial%pv_virial,itimes,& 00427 "AVE_PV_KIN",averages%virial%pv_kinetic,itimes,& 00428 "AVE_PV_CNSTR",averages%virial%pv_constraint,itimes,& 00429 "AVE_PV_XC",averages%virial%pv_xc,itimes,& 00430 "AVE_PV_FOCK_4C",averages%virial%pv_fock_4c,itimes 00431 END IF 00432 END IF 00433 DO i = 1, nint 00434 ctmp = cp_to_string(i) 00435 WRITE(output_unit,FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)')& 00436 TRIM("AVE_CV-"//ADJUSTL(ctmp)),averages%avecolvar(i),itimes 00437 END DO 00438 WRITE(output_unit,FMT='(/)') 00439 END IF 00440 CALL cp_print_key_finished_output(output_unit,logger,averages%averages_section,& 00441 "PRINT_AVERAGES", error=error) 00442 END IF 00443 CALL timestop(handle) 00444 END SUBROUTINE compute_averages 00445 00446 ! ***************************************************************************** 00450 SUBROUTINE get_averages_rs(avg, add, delta_t, error) 00451 REAL(KIND=dp), INTENT(INOUT) :: avg 00452 REAL(KIND=dp), INTENT(IN) :: add 00453 INTEGER, INTENT(IN) :: delta_t 00454 TYPE(cp_error_type), INTENT(inout) :: error 00455 00456 CHARACTER(len=*), PARAMETER :: routineN = 'get_averages_rs', 00457 routineP = moduleN//':'//routineN 00458 00459 LOGICAL :: failure 00460 00461 failure = .FALSE. 00462 avg = (avg*REAL(delta_t-1,dp) + add)/REAL(delta_t,dp) 00463 END SUBROUTINE get_averages_rs 00464 00465 ! ***************************************************************************** 00469 SUBROUTINE get_averages_rv(avg, add, delta_t, error) 00470 REAL(KIND=dp), DIMENSION(:), 00471 INTENT(INOUT) :: avg 00472 REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: add 00473 INTEGER, INTENT(IN) :: delta_t 00474 TYPE(cp_error_type), INTENT(inout) :: error 00475 00476 CHARACTER(len=*), PARAMETER :: routineN = 'get_averages_rv', 00477 routineP = moduleN//':'//routineN 00478 00479 INTEGER :: i 00480 LOGICAL :: check, failure 00481 00482 failure = .FALSE. 00483 check = SIZE(avg)==SIZE(add) 00484 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00485 DO i = 1, SIZE(avg) 00486 avg(i) = (avg(i)*REAL(delta_t-1,dp) + add(i))/REAL(delta_t,dp) 00487 END DO 00488 END SUBROUTINE get_averages_rv 00489 00490 ! ***************************************************************************** 00494 SUBROUTINE get_averages_rm(avg, add, delta_t, error) 00495 REAL(KIND=dp), DIMENSION(:, :), 00496 INTENT(INOUT) :: avg 00497 REAL(KIND=dp), DIMENSION(:, :), 00498 INTENT(IN) :: add 00499 INTEGER, INTENT(IN) :: delta_t 00500 TYPE(cp_error_type), INTENT(inout) :: error 00501 00502 CHARACTER(len=*), PARAMETER :: routineN = 'get_averages_rm', 00503 routineP = moduleN//':'//routineN 00504 00505 INTEGER :: i, j 00506 LOGICAL :: check, failure 00507 00508 failure = .FALSE. 00509 check = SIZE(avg,1)==SIZE(add,1) 00510 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00511 check = SIZE(avg,2)==SIZE(add,2) 00512 CPPostcondition(check,cp_failure_level,routineP,error,failure) 00513 DO i = 1, SIZE(avg,2) 00514 DO j = 1, SIZE(avg,1) 00515 avg(j,i) = (avg(j,i)*REAL(delta_t-1,dp) + add(j,i))/REAL(delta_t,dp) 00516 END DO 00517 END DO 00518 END SUBROUTINE get_averages_rm 00519 00520 END MODULE averages_types
1.7.3