Changeset 963 for codes/icosagcm/trunk/src/dissip
- Timestamp:
- 07/25/19 11:36:36 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/trunk/src/dissip/dissip_gcm.F90
r954 r963 4 4 PRIVATE 5 5 6 TYPE(t_field),POINTER,SAVE :: f_due_diss 1(:)7 TYPE(t_field),POINTER,SAVE :: f_due_diss 2(:)6 TYPE(t_field),POINTER,SAVE :: f_due_diss_gradiv(:) 7 TYPE(t_field),POINTER,SAVE :: f_due_diss_gradrot(:) 8 8 9 9 TYPE(t_field),POINTER,SAVE :: f_dtheta_diss(:) 10 10 TYPE(t_field),POINTER,SAVE :: f_dtheta_rhodz_diss(:) 11 TYPE(t_message),SAVE :: req_due , req_dtheta11 TYPE(t_message),SAVE :: req_due_gradiv, req_due_gradrot, req_dtheta 12 12 13 13 INTEGER,SAVE :: nitergdiv=1 … … 47 47 SUBROUTINE allocate_dissip 48 48 USE icosa 49 IMPLICIT NONE 50 CALL allocate_field(f_due_diss 1,field_u,type_real,llm,ondevice=.TRUE.)51 CALL allocate_field(f_due_diss 2,field_u,type_real,llm,ondevice=.TRUE.)49 IMPLICIT NONE 50 CALL allocate_field(f_due_diss_gradiv,field_u,type_real,llm,ondevice=.TRUE.) 51 CALL allocate_field(f_due_diss_gradrot,field_u,type_real,llm,ondevice=.TRUE.) 52 52 CALL allocate_field(f_dtheta_diss,field_t,type_real,llm) 53 53 CALL allocate_field(f_dtheta_rhodz_diss,field_t,type_real,llm,ondevice=.TRUE.) … … 140 140 CALL allocate_field(f_dtheta,field_t,type_real,ondevice=.TRUE.) 141 141 142 CALL init_message(f_due_diss1,req_e1_vect,req_due) 143 CALL init_message(f_dtheta_diss,req_i1,req_dtheta) 142 CALL init_message(f_due_diss_gradiv,req_e1_vect,req_due_gradiv) 143 CALL init_message(f_due_diss_gradrot,req_e1_vect,req_due_gradrot) 144 CALL init_message(f_dtheta_rhodz_diss,req_i1,req_dtheta) 144 145 145 146 tau_graddiv(:)=5000 … … 548 549 549 550 CALL trace_start("dissip") 550 CALL gradiv(f_ue,f_due_diss 1)551 CALL gradrot(f_ue,f_due_diss 2)551 CALL gradiv(f_ue,f_due_diss_gradiv) 552 CALL gradrot(f_ue,f_due_diss_gradrot) 552 553 553 554 CALL divgrad_theta_rhodz(f_mass,f_theta_rhodz,f_dtheta_rhodz_diss) … … 558 559 CALL swap_geometry(ind) 559 560 due=f_due(ind) 560 due_diss1=f_due_diss 1(ind)561 due_diss2=f_due_diss 2(ind)561 due_diss1=f_due_diss_gradiv(ind) 562 due_diss2=f_due_diss_gradrot(ind) 562 563 dtheta_rhodz=f_dtheta_rhodz(ind) 563 564 dtheta_rhodz_diss=f_dtheta_rhodz_diss(ind) … … 653 654 USE output_field_mod 654 655 655 CALL transfert_request(f_due_diss 1,req_e1_vect)656 CALL un2ulonlat(f_due_diss 1, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))656 CALL transfert_request(f_due_diss_gradiv,req_e1_vect) 657 CALL un2ulonlat(f_due_diss_gradiv, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1)))) 657 658 CALL output_field("dulon_diss1",f_buf_ulon) 658 659 CALL output_field("dulat_diss1",f_buf_ulat) 659 660 ! 660 CALL transfert_request(f_due_diss 2,req_e1_vect)661 CALL un2ulonlat(f_due_diss 2, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1))))661 CALL transfert_request(f_due_diss_gradrot,req_e1_vect) 662 CALL un2ulonlat(f_due_diss_gradrot, f_buf_ulon, f_buf_ulat, (1./(tau_graddiv(1)))) 662 663 CALL output_field("dulon_diss2",f_buf_ulon) 663 664 CALL output_field("dulat_diss2",f_buf_ulat) … … 699 700 700 701 DO it=1,nitergdiv 701 CALL send_message(f_due,req_due) 702 CALL wait_message(req_due) 703 702 CALL send_message(f_due,req_due_gradiv) 703 CALL wait_message(req_due_gradiv) 704 704 DO ind=1,ndomain 705 705 IF (.NOT. assigned_domain(ind)) CYCLE … … 749 749 750 750 DO it=1,nitergrot 751 CALL send_message(f_due,req_due )752 CALL wait_message(req_due )751 CALL send_message(f_due,req_due_gradrot) 752 CALL wait_message(req_due_gradrot) 753 753 754 754 DO ind=1,ndomain
Note: See TracChangeset
for help on using the changeset viewer.