Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r3292 r3294 38 38 USE dianam ! build name of file 39 39 USE lib_mpp ! distributed memory computing library 40 #if defined key_ ice_lim2 || defined key_ice_lim340 #if defined key_lim2 || defined key_lim3 41 41 USE ice 42 42 #endif 43 43 USE domvvl 44 USE timing ! preformance summary 45 USE wrk_nemo ! working arrays 44 46 45 47 IMPLICIT NONE … … 114 116 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 115 117 118 IF( nn_timing == 1 ) CALL timing_start('dia_dct_init') 119 116 120 !read namelist 117 121 REWIND( numnam ) … … 147 151 ENDIF 148 152 149 153 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init') 154 ! 150 155 END SUBROUTINE dia_dct_init 151 156 … … 161 166 162 167 !! * Local variables 163 INTEGER :: jsec, &!loop on sections 164 iost !error for opening fileout 165 LOGICAL :: lldebug =.FALSE. !debug a section 166 CHARACTER(len=160) :: clfileout !fileout name 168 INTEGER :: jsec, &! loop on sections 169 iost, &! error for opening fileout 170 itotal ! nb_sec_max*nb_type_class*nb_class_max 171 LOGICAL :: lldebug =.FALSE. ! debug a section 172 CHARACTER(len=160) :: clfileout ! fileout name 167 173 168 174 169 INTEGER , DIMENSION(1) :: ish! tmp array for mpp_sum170 INTEGER , DIMENSION(3) :: ish2! "171 REAL(wp), DIMENSION(nb_sec_max*nb_type_class*nb_class_max):: zwork ! "172 REAL(wp), DIMENSION(nb_sec_max,nb_type_class,nb_class_max):: zsum ! "175 INTEGER , DIMENSION(1) :: ish ! tmp array for mpp_sum 176 INTEGER , DIMENSION(3) :: ish2 ! " 177 REAL(wp), POINTER, DIMENSION(:) :: zwork ! " 178 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! " 173 179 174 180 !!--------------------------------------------------------------------- 175 181 IF( nn_timing == 1 ) CALL timing_start('dia_dct') 182 183 IF( lk_mpp )THEN 184 itotal = nb_sec_max*nb_type_class*nb_class_max 185 CALL wrk_alloc( itotal , zwork ) 186 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 187 ENDIF 188 176 189 IF( lwp .AND. kt==nit000+nn_dct-1 ) THEN 177 190 WRITE(numout,*) " " … … 189 202 !debug this section computing ? 190 203 lldebug=.FALSE. 191 ! IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 192 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 ) lldebug=.TRUE. 204 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 193 205 194 206 !Compute transport through section … … 226 238 ENDIF 227 239 240 IF( lk_mpp )THEN 241 itotal = nb_sec_max*nb_type_class*nb_class_max 242 CALL wrk_dealloc( itotal , zwork ) 243 CALL wrk_dealloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 244 ENDIF 245 246 IF( nn_timing == 1 ) CALL timing_stop('dia_dct') 247 ! 228 248 END SUBROUTINE dia_dct 229 249 … … 250 270 TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates 251 271 !read in the file 252 INTEGER, DIMENSION(nb_point_max) ::directemp!contains listpoints directions272 INTEGER, POINTER, DIMENSION(:) :: directemp !contains listpoints directions 253 273 !read in the files 254 274 LOGICAL :: llbon ,&!local logical 255 275 lldebug !debug the section 256 276 !!------------------------------------------------------------------------------------- 277 CALL wrk_alloc( nb_point_max, directemp ) 257 278 258 279 !open input file … … 381 402 ENDIF 382 403 404 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 405 WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 406 DO jpt = 1,iptloc 407 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 408 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 409 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo 410 ENDDO 411 ENDIF 412 383 413 !remove redundant points between processors 384 414 !------------------------------------------ … … 390 420 CALL removepoints(secs(jsec),'J','bot_list',lldebug) 391 421 ENDIF 422 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 423 WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc 424 DO jpt = 1,secs(jsec)%nb_point 425 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 426 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 427 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo 428 ENDDO 429 ENDIF 392 430 393 431 !debug … … 395 433 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN 396 434 WRITE(numout,*)" List of points after removepoints:" 435 iptloc = secs(jsec)%nb_point 397 436 DO jpt = 1,iptloc 398 437 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 … … 411 450 nb_sec = jsec-1 !number of section read in the file 412 451 452 CALL wrk_dealloc( nb_point_max, directemp ) 453 ! 413 454 END SUBROUTINE readsec 414 455 … … 436 477 ! isgn=-1 : scan listpoint from end to start 437 478 istart,iend !first and last points selected in listpoint 438 INTEGER :: jpoint =0!loop on list points439 INTEGER, DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction440 INTEGER, DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint479 INTEGER :: jpoint !loop on list points 480 INTEGER, POINTER, DIMENSION(:) :: idirec !contains temporary sec%direction 481 INTEGER, POINTER, DIMENSION(:,:) :: icoord !contains temporary sec%listpoint 441 482 !---------------------------------------------------------------------------- 483 CALL wrk_alloc( nb_point_max, idirec ) 484 CALL wrk_alloc( 2, nb_point_max, icoord ) 485 442 486 IF( ld_debug )WRITE(numout,*)' -------------------------' 443 487 IF( ld_debug )WRITE(numout,*)' removepoints in listpoint' … … 467 511 sec%direction = 0 468 512 469 470 513 jpoint=iextr+isgn 471 DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point .AND. & 472 icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest ) 473 jpoint=jpoint+isgn 474 ENDDO 514 DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point ) 515 IF( icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest )THEN ; jpoint=jpoint+isgn 516 ELSE ; EXIT 517 ENDIF 518 ENDDO 475 519 476 520 IF( cdextr=='bot_list')THEN ; istart=jpoint-1 ; iend=sec%nb_point 477 521 ELSE ; istart=1 ; iend=jpoint+1 478 522 ENDIF 523 479 524 sec%listPoint(1:1+iend-istart)%I = icoord(1,istart:iend) 480 525 sec%listPoint(1:1+iend-istart)%J = icoord(2,istart:iend) … … 487 532 ENDIF 488 533 534 CALL wrk_dealloc( nb_point_max, idirec ) 535 CALL wrk_dealloc( 2, nb_point_max, icoord ) 489 536 END SUBROUTINE removepoints 490 537 … … 536 583 537 584 TYPE(POINT_SECTION) :: k 538 REAL(wp), DIMENSION(nb_type_class,nb_class_max)::zsum585 REAL(wp), POINTER, DIMENSION(:,:):: zsum ! 2D work array 539 586 !!-------------------------------------------------------- 587 CALL wrk_alloc( nb_type_class , nb_class_max , zsum ) 540 588 541 589 IF( ld_debug )WRITE(numout,*)' Compute transport' … … 746 794 ENDDO !end of loop on the density classes 747 795 748 #if defined key_ ice_lim796 #if defined key_lim2 || defined key_lim3 749 797 750 798 !ICE CASE … … 812 860 sec%transport(2,jclass)=sec%transport(2,jclass)+zsum(2,jclass)*1.E-6 813 861 IF( sec%llstrpond ) THEN 814 IF( zsum(1,jclass) .NE. 0 ) THEN 815 sec%transport(3,jclass)=sec%transport(3,jclass)+zsum(3,jclass)/zsum(1,jclass) 816 sec%transport(5,jclass)=sec%transport(5,jclass)+zsum(5,jclass)/zsum(1,jclass) 817 sec%transport(7,jclass)=sec%transport(7,jclass)+zsum(7,jclass) 818 sec%transport(9,jclass)=sec%transport(9,jclass)+zsum(9,jclass) 819 ELSE 820 sec%transport(3,jclass)=0. 821 sec%transport(5,jclass)=0. 822 sec%transport(7,jclass)=0. 823 sec%transport(9,jclass)=0. 862 IF( zsum(1,jclass) .NE. 0._wp ) THEN 863 sec%transport( 3,jclass) = sec%transport( 3,jclass) + zsum( 3,jclass)/zsum(1,jclass) 864 sec%transport( 5,jclass) = sec%transport( 5,jclass) + zsum( 5,jclass)/zsum(1,jclass) 865 sec%transport( 7,jclass) = sec%transport( 7,jclass) + zsum( 7,jclass) 866 sec%transport( 9,jclass) = sec%transport( 9,jclass) + zsum( 9,jclass) 824 867 ENDIF 825 IF( zsum(2,jclass) .NE. 0 )THEN 826 sec%transport( 4,jclass)=sec%transport( 4,jclass)+zsum( 4,jclass)/zsum(2,jclass) 827 sec%transport( 6,jclass)=sec%transport( 6,jclass)+zsum( 6,jclass)/zsum(2,jclass) 828 sec%transport( 8,jclass)=sec%transport( 8,jclass)+zsum( 8,jclass) 829 sec%transport(10,jclass)=sec%transport(10,jclass)+zsum(10,jclass) 830 ELSE 831 sec%transport( 4,jclass)=0. 832 sec%transport( 6,jclass)=0. 833 sec%transport( 8,jclass)=0. 834 sec%transport(10,jclass)=0. 868 IF( zsum(2,jclass) .NE. 0._wp )THEN 869 sec%transport( 4,jclass) = sec%transport( 4,jclass) + zsum( 4,jclass)/zsum(2,jclass) 870 sec%transport( 6,jclass) = sec%transport( 6,jclass) + zsum( 6,jclass)/zsum(2,jclass) 871 sec%transport( 8,jclass) = sec%transport( 8,jclass) + zsum( 8,jclass) 872 sec%transport(10,jclass) = sec%transport(10,jclass) + zsum(10,jclass) 835 873 ENDIF 836 874 ELSE 837 sec%transport( 3,jclass) =0.838 sec%transport( 4,jclass) =0.839 sec%transport( 5,jclass) =0.840 sec%transport( 6,jclass) =0.841 sec%transport( 7,jclass) =0.842 sec%transport( 8,jclass) =0.843 sec%transport(10,jclass) =0.875 sec%transport( 3,jclass) = 0._wp 876 sec%transport( 4,jclass) = 0._wp 877 sec%transport( 5,jclass) = 0._wp 878 sec%transport( 6,jclass) = 0._wp 879 sec%transport( 7,jclass) = 0._wp 880 sec%transport( 8,jclass) = 0._wp 881 sec%transport(10,jclass) = 0._wp 844 882 ENDIF 845 883 ENDDO … … 852 890 ENDIF 853 891 892 CALL wrk_dealloc( nb_type_class , nb_class_max , zsum ) 893 ! 854 894 END SUBROUTINE transport 855 895 … … 872 912 !!------------------------------------------------------------- 873 913 !!arguments 874 INTEGER, INTENT(IN) :: kt ! time-step875 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write876 INTEGER ,INTENT(IN) :: ksec ! section number914 INTEGER, INTENT(IN) :: kt ! time-step 915 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write 916 INTEGER ,INTENT(IN) :: ksec ! section number 877 917 878 918 !!local declarations 879 REAL(wp) ,DIMENSION(nb_type_class):: zsumclass 880 INTEGER :: jcl,ji ! Dummy loop 881 CHARACTER(len=2) :: classe ! Classname 882 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 883 REAL(wp) :: zslope ! section's slope coeff 919 INTEGER :: jcl,ji ! Dummy loop 920 CHARACTER(len=2) :: classe ! Classname 921 REAL(wp) :: zbnd1,zbnd2 ! Class bounds 922 REAL(wp) :: zslope ! section's slope coeff 923 ! 924 REAL(wp), POINTER, DIMENSION(:):: zsumclass ! 1D workspace 884 925 !!------------------------------------------------------------- 885 926 CALL wrk_alloc(nb_type_class , zsumclass ) 927 886 928 zsumclass(:)=0._wp 887 929 zslope = sec%slopeSection … … 996 1038 119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6) 997 1039 1040 CALL wrk_dealloc(nb_type_class , zsumclass ) 998 1041 END SUBROUTINE dia_dct_wri 999 1042
Note: See TracChangeset
for help on using the changeset viewer.
